Товарищи, я тут нашёл в черновиках статью аж от 2013 года. Публикую.

Статья написана сразу после «Дружественность» в Delphi. Статья является логическим продолжением серии переводов Полиморфизм ad nauseum и последующего обсуждения в Delphi-блогах.

За давностью лет я уж и забыл, почему она в черновиках. Возможно, не всё сказал, что хотел. Может, творческий запал оборвался. А может, местами коряво получилось, не вычитал. Там в конце было что-то про журнал — возможно, я планировал опубликовать это в журнале. Также, материал про соединение потоков и файлов планировался в серию про сериализацию. Сырцы к статье чудом нашёл в бэкапе проектов. Короче, сделайте скидку.

---

В первой статье «Что такое полиморфизм» Всеволод Леонов простым языком объяснил на наглядных примерах, что такое полиморфизм. В этой, второй, статье мы попробуем применить полиморфизм на практике.

Полиморфизм, ООП и графический интерфейс

Полиморфизм является одним из ключевых понятий (наравне с инкапсуляцией, абстракцией и наследованием) для объектно-ориентированного программирования (ООП). Хотя, конечно, полиморфизм не является эксклюзивным свойством именно ООП. Тем не менее, в этой статье мы будем говорить практически только про ООП.

ООП зародилось давно — в конце 50-х/начале 60-х годах прошлого века. Сначала концепция объектов выражалась доступными средствами языков программирования, а потом она была закреплена и в синтаксисе языков. Первым таким языком стала Симула (середина 60-х). В ней были многие современные возможности: класс, объекты, виртуальные методы и т.д. Тем не менее, более 30 лет парадигма ООП оставалась в тени, не признанная сообществом программистом. Действительно, если вашей программе нужно сделать выборку из базы данных, затем что-то посчитать и составить отчёт, то тут не так уж много возможностей для ООП. Ситуация кардинально поменялась в начале-середине 90-х годов прошлого века — в связи с развитием графических интерфейсов. Графический интерфейс — штука достаточно сложная, здесь требуется манипулировать большим количеством разнообразных элементов. А ООП позволяет это здорово упростить. Возможности ООП привлекли внимание разработчиков, и с тех пор ООП является доминирующей концепцией (иными словами, количество языков программирования, реализующих объектно-ориентированную парадигму, является наибольшим по отношению к другим парадигмам).

Итак, раз уж исторически ООП популяризировалось именно за счёт графического интерфейса, то почему бы нам не начать с ООП и примера на графический интерфейс?

Немного об ООП

ООП строится на понятии классов и объектов. Класс — это своего рода шаблон, «проект дома на бумаге». Он определяет методы, свойства и события. По этим шаблонам создаются объекты. Объект — это экземпляр класса, «конкретный дом». Это некая цельная сущность, соединяющая воедино данные и методы по управлению ими. У одного класса может быть много объектов, но каждый объект принадлежит лишь одному классу. Все объекты одного класса будут иметь одинаковый набор свойств, методов и событий, но значения свойств и назначенные обработчики могут отличаться:

// Класс ("проект дома", тип данных):
type
  TMyButton = class
    procedure Click;
  end;

// Объекты ("дома, построенные по проекту", переменные типа данных):
var
  OKButton: TMyButton;
  CancelButton: TMyButton;
  HelpButton: TMyButton;

begin
  // "Проект" говорит, что можно щёлкать:
  OKButton.Click;
end;

// Выполняется для OK, Cancel и Help
procedure TMyButton.Click;
begin
  // ...
end;

Одна из самых больших проблем с ООП — научиться думать в терминах объектов. Как правило, человек, не знакомый с ООП, видит перед собой «просто полотно кода». Сообразить, что этот код ассоциируется с каким-то объектом, имеет структуру — именно это сложно. Иными словами, для него нет разницы между Click и TMyButton.Click.

Чтобы научиться мыслить в терминах объектов, нужно думать абстрактно, а не конкретно. Если вы удачно выберете абстракцию, то система будет представлена чёткой картиной, в которой будет легко разобраться. Уменьшение сложности понимания кода достигается сокрытием реализации.

К примеру, в примере выше у нас есть абстракция — «кнопка». Вы можете её создать, вы можете на ней «щёлкнуть» (Click). При этом вам не нужно думать: «а как же это работает? Что нужно сделать в коде, чтобы создать кнопку? А щелчок — это что же: мышью на неё навести и нажать кнопку?».

Полиморфизм в графическом интерфейсе

Мы можем «бросать» на форму разные визуальные элементы управления: кнопки, списки, поля ввода и так далее. Каждый из них уникален, он выглядит и ведёт себя индивидуально, по-разному. Тем не менее, все они должны уметь позиционировать себя на форме, все они должны уметь себя рисовать, и, как правило, все они поддерживают отображение/ввод заголовка (Caption/Text).

Сказанное означает, что концептуально у нас есть общая сущность — «элемент управления», которая умеет себя рисовать, задавать своё положение и указывать заголовок (текст), но каждый конкретный элемент управления будет реализовывать эти общие свойства по своему. Итого, в терминах ООП у нас получаются такие структуры данных:

type
  // Общий класс 
  TMyControl = class
  strict private
    function GetBounds: TRect;
    procedure SetBounds(const AValue: TRect);
    function GetText: String;
    procedure SetText(const AValue: String);
  public
    // Публичный интерфейс, контракт - то, что должен уметь делать объект этого класса:
    property Bounds: TRect read GetBounds write SetBounds;
    property Text: String read GetText write SetText;
    procedure Draw; 
  end;

  // Несколько примеров конкретных классов:
  TMyButton = class(TMyControl)
  end;

  TMyEdit = class(TMyControl)
  end;

  TMyLabel = class(TMyControl)
  end;

Конечно же, каждый конкретный класс должен указывать, как он будет располагаться, как он будет рисоваться, как он будет использовать свой текст. Вот здесь на сцену и выходит полиморфизм.

В Delphi есть много технических способов обеспечить полиморфизм — полный список был приведён в предыдущей статье. Если мы говорим про ООП, то основными способами будут:

• virtual/dynamic методы
• message методы
• событие (процедурный указатель)
• интерфейсы

Вот давайте на них и посмотрим.

Виртуальные методы

Чтобы использовать полиморфизм, вам нужно иметь класс с методом. Этот метод вы должны объявить виртуальным, указав ключевое слово virtual:

type
  TMyControl = class
    // Объявление виртуального метода
    procedure Draw; virtual;
  end;

После этого вы можете создать наследник класса, в котором вы можете заместить реализацию метода на свою собственную, отличную от унаследованной. Чтобы указать на замещение реализации, вам нужно использовать ключевое слово override:

type
  TMyButton = class(TMyControl)
    // Замещение виртуального метода в классе-наследнике
    procedure Draw; override;
  end;

Разумеется, виртуальный метод для замещения должен быть доступен классу-наследнику — т.е. он должен находится в любой секции, кроме private и strict private.

Тогда при вызове метода у базового класса будет вызываться не его реализация, а замещённая реализация в наследнике. Например:

type
  TMyControl = class
    procedure Draw; virtual; 
  end;

  TMyButton = class(TMyControl)
    procedure Draw; override;
  end;

  TMyEdit = class(TMyControl)
    procedure Draw; override;
  end;

var
  Controls: array of TMyControl;
begin
  SetLength(Controls, 2);
  Controls[0] := TMyButton.Create;
  Controls[1] := TMyEdit.Create;

  for X := 0 to High(Controls) do
    // Вызовет сначала TMyButton.Draw, а затем TMyEdit.Draw
    Controls[X].Draw; 
end;

В чём же здесь разница между виртуальными (полиморфными) методами и обычными статическими (не полиморфными) методами?

var
  Control1: TMyButton;
  Control2: TMyEdit;
begin
  // Если метод Draw - статический:
  Control1 := TMyButton.Create;
  Control1.Draw; // вызывает TMyButton.Draw
  FreeAndNil(Control1);
  Control2 := TMyEdit.Create;
  Control2.Draw; // вызывает TMyEdit.Draw 
  FreeAndNil(Control2);

  // Если метод Draw - виртуальный:
  Control1 := TMyButton.Create;
  Control1.Draw; // вызывает TMyButton.Draw
  FreeAndNil(Control1);
  Control2 := TMyEdit.Create;
  Control2.Draw; // вызывает TMyEdit.Draw 
  FreeAndNil(Control2);
end;

Здесь кажется, что разницы нет. Дело в том, что разница видна именно при использовании базового класса для ссылки на конкретный класс:

var
  Control: TControl;
begin
  // Если метод Draw - статический:
  Control := TMyButton.Create;
  Control.Draw; // вызывает TMyControl.Draw
  FreeAndNil(Control);
  Control := TMyEdit.Create;
  Control.Draw; // вызывает TMyControl.Draw 
  FreeAndNil(Control);

  // Если метод Draw - виртуальный:
  Control := TMyButton.Create;
  Control.Draw; // вызывает TMyButton.Draw
  FreeAndNil(Control);
  Control := TMyEdit.Create;
  Control.Draw; // вызывает TMyEdit.Draw 
  FreeAndNil(Control);
end;

Иными словами, вам не нужен полиморфизм, когда вы хотите работать с одним конкретным объектом. Но как только у вас на сцене появляется несколько разных объектов с общими свойствами или поведением, и вам нужно сделать одно действие для всех объектов (или хранить их в общем списке или ещё что-то общее) — вот именно тут проявляется полиморфизм.

Примечание: наряду с виртуальными методами в Delphi есть динамические методы. С точки зрения поведения они ничем не отличаются от виртуальных. Разница между ними в том, что виртуальные вызовы оптимизированы на скорость работы, а динамические методы оптимизированы на минимальные размер занимаемой памяти. В современных условиях вам следует всегда использовать виртуальные методы, т.к. сегодня оптимизация по скорости представляется более ценной, чем оптимизация по размеру.

Итак, с этими знаниями теперь мы можем обновить наш исходный пример например так:

type
  // Общий класс 
  TMyControl = class
  strict private
    FText: String;
    FBounds: TRect;
  strict protected
    function GetBounds: TRect; virtual;
    procedure SetBounds(const AValue: TRect); virtual;
    function GetText: String; virtual; 
    procedure SetText(const AValue: String); virtual; 
  public
    // Публичный интерфейс, контракт - то, что должен уметь делать объект этого класса:
    property Bounds: TRect read GetBounds write SetBounds;
    property Text: String read GetText write SetText;
    procedure Draw; virtual; abstract;
  end;

  // Несколько примеров конкретных классов:
  TMyButton = class(TMyControl)
  public 
    procedure Draw; override;
  end;

  TMyEdit = class(TMyControl)
  public 
    procedure Draw; override;
  end;

  TMyLabel = class(TMyControl)
  public 
    procedure Draw; override;
  end;

{ TMyControl }

function TMyControl.GetBounds: TRect;
begin
  Result := FBounds;
end;

procedure TMyControl.SetBounds(const AValue: TRect); 
begin
  FBounds := AValue;
  Draw;
end;

function TMyControl.GetText: String;
begin
  Result := FText;
end;

procedure TMyControl.SetText(const AValue: String);
begin
  FText := AValue;
  Draw;
end;

// Простейшие рисунки для элементов управления:

{ TMyButton }

procedure TMyButton.Draw;
begin
  Brush.Color := clBtnFace;
  Canvas.FillRect(Bounds);
  Canvas.TextOutXY(Bounds.Left, Bounds.Top, Text);
end;

{ TMyEdit }

procedure TMyEdit.Draw; 
begin
  Brush.Color := clWhite;
  Canvas.FillRect(Bounds);
  Canvas.TextOutXY(Bounds.Left, Bounds.Top, Text);
end;

{ TMyLabel }

procedure TMyLabel.Draw;
begin
  Canvas.TextOutXY(Bounds.Left, Bounds.Top, Text);
end;

Вы можете использовать ключевое слово abstract, написав его после virtual, чтобы указать на то, что у виртуального метода нет реализации. Действительно TMyControl не умеет себя рисовать — он не является настоящим элементом управления, ему просто нечего рисовать. Вот почему мы объявили виртуальный метод абстрактным. Конкретные наследники TMyControl должны обязательно заместить абстрактный метод, указав свою конкретную реализацию. Это не строго необходимо для просто виртуальных методов — которые можно замещать при необходимости, но можно и не замещать — если вас устраивает реализация по умолчанию в базовом классе. В этом примере нас устраивает реализация для свойств, поэтому мы замещаем только метод рисования.

Следует также упомянуть, что при замещении метода в классе вы имеете возможность вызвать предыдущую реализацию. Это удобно, если вы не хотите переписывать метод с нуля, а хотите лишь слегка модифицировать его. Это делается с использованием ключевого слова inherited. Этот механизм не специфичен именно для виртуальных методов и может использоваться с любыми методами. В любом случае, в зависимости от реализации базового класса, класс-наследник может решить вызывать унаследованный метод в самом начале, перед выполнением своих действий, либо в середине (довольно редко), либо после своих действий, в конце, либо же не вызывать вовсе.

Существует два способа вызова унаследованного варианта метода, с тонкими отличиями:

procedure TRectangle.Draw(Canvas: TCanvas);
begin
  inherited Draw(Canvas);
  Canvas.Rectangle(FRect);
end;

Этот код безусловно вызовет унаследованный метод Draw базового класса. Если метод в базовом классе — абстрактный, то этот вызов завершиться неудачей, возбуждая исключение EAbstractError во время выполнения.

Альтернативный синтаксис вызова — просто написать inherited;, например:

procedure TRectangle.Draw(Canvas: TCanvas);
begin
  inherited;
  Canvas.Rectangle(FRect);
end;

Этот код будет работать идентично предыдущему для случаев, когда базовый класс содержит не абстрактный метод. Если же метод базового класса является абстрактным, либо же базовый класс вообще не содержит метода (для не виртуальных методов), то вызов inherited становится noop (No-Operation — пустым оператором). Компилятор не генерирует для него кода (и поэтому вы не можете поставить на него точку останова). Этот механизм является частью отличной версионной устойчивости языка Delphi. Достоинством же первого способа является возможность изменить аргументы к унаследованному вызову.

message-методы

Message-методы являются разновидностью динамических методов. В основном они используются для диспетчеризации оконных сообщений, но в целом могут использоваться и более широко. Мы не будем рассматривать их в этой статье.

События

Помимо положения, текста и умения отрисовываться некоторые элементы управления должны реагировать на ввод пользователя. К примеру, кнопка должна уметь воспринимать щелчок пользователя по ней. Мы можем попытаться применить предыдущий подход:

type
  TMyButton = class(TMyControl)
  public
    procedure Draw; override;
    procedure Click; virtual;
  end;

  TMyOKButton = class(TMyButton)
  public
    procedure Click; override;
  end;

  TMyCancelButton = class(TMyButton)
  public
    procedure Click; override;
  end;

procedure TMyButton.Click; 
begin
  // ничего не делать - простая кнопка игнорирует щелчок
end;

procedure TMyOKButton.Click; 
begin
  ModalResult := mrOK;
  CloseDialog;
end;

procedure TMyCancelButton.Click; 
begin
  ModalResult := mrCancel;
  CloseDialog;
end;

Конечно, такой подход не является жутко удобным. Вам нужно порождать новые классы для минимальных изменений в их поведении. Фактически, у вас будет по одному объекту каждого класса, потому что классы становятся слишком узкоспециализированными.

Здесь на сцену выходят события. Событие — это обычный процедурный указатель. Т.е. это указатель на код. Если вы введёте в класс свойство типа событие, то это будет означать, что объекты этого класса смогут менять не только свои данные (текст, положение и т.п.), но и поведение.

type
  TClickEvent = procedure of object; 
  // или:
  TClickEvent = procedure; 

  TMyButton = class(TMyControl)
  strict private
    FClickEvent: TClickEvent;
  protected 
    procedure DoClick;
  public
    procedure Draw; override;
    property OnClick: TClickEvent read FClickEvent write FClickEvent;
  end;

procedure TMyButton.DoClick;
begin
  if Assigned(FClickEvent) then
    FClickEvent;   
end;

// ...

procedure TMyDialog.OKClick;
// или:
procedure OKClick;
begin
  ModalResult := mrOk;
  CloseDialog;
end;

procedure TMyDialog.CancelClick;
// или:
procedure CancelClick;
begin
  ModalResult := mrCancel;
  CloseDialog;
end;

var
  Dialog: TMyDialog;
  OKButton: TMyButton;
  CancelButton: TMyButton;
begin
  OKButton := TMyButton.Create;
  CancelButton := TMyButton.Create;

  OKButton.OnClick := Dialog.OKClick;
  // или:
  OKButton.OnClick := OKClick;

  CancelButton.OnClick := Dialog.CancelClick;
  // или:
  CancelButton.OnClick := CancelClick;

  // ...
end;

В этом примере показаны события как в виде чистого процедурного указателя (procedure), так и в виде указателя на метод (procedure of object). Разница между ними состоит лишь в том, что первый может указывать только на обычную функцию или процедуру, а второй должен указывать только на метод объекта. В остальном эти два понятия идентичны.

Как вы видите из кода выше, событие состоит из двух частей: OnClick — свойства процедурного типа (приёмник) и DoClick — вызывающего метода (отправитель). В такой реализации (невиртуальный) метод DoClick эквивалентен виртуальному методу Click из предыдущего примера. Вы вызываете этот метод, когда вам нужно щёлкнуть по кнопке. Виртуальный Click реализовывал полиморфизм замещением метода разными реализациями в наследниках класса. Событие же реализует полиморфизм путём назначения различных реализаций процедурному указателю.

Заметьте, что события в виде чисто процедурных указателей позволяют реализовывать полиморфное поведение не-ООП коду (например — процедурному).

Интерфейсы

Если вы вернётесь немного назад и посмотрите на пример с виртуальными методами, то заметите, что у нас там есть два класса: основной базовый и наследник (или несколько наследников). По сути задача базового класса в этом случае — сформировать контракт по взаимодействию с объектами этого класса. Сам по себе этот класс не содержит никакой уникальной реализации. Это просто служебный код.

Основная проблема здесь в том, что почти всегда объектам нужно удовлетворять нескольким контрактам. К примеру, объект может быть «элементом управления» — поддерживать позиционирование и уметь рисовать себя, объект может быть «текстовым элементом» — уметь отображать и/или вводить текст, объект может быть «кликабельным» — уметь реагировать на щелчки и так далее. В рамках ООП и наследование это решается построением правильного дерева наследования. Вот пример настоящего дерева наследования из Delphi (фрагменты):

Не всегда это можно сделать удачно. Иногда бывают ситуации, когда класс с аналогичной функциональностью вынужден создавать свою собственную ветку — только из-за того, что какая-то деталь реализации отлична. Вот, к примеру, дерево для TSpeedButton:

Обратите внимание, что несмотря на то, что это — кнопка (и, значит, по логике должна наследоваться от TCustomButton или TButton), TSpeedButton наследуется от совершенно не связанной ветки дерева — и всё потому, что она является пользовательским, а не оконным контролом: к примеру, у неё нет оконного описателя (который вводится в TWinControl — предка TButton).

Ещё более ярко это проявляется в современных версиях Delphi — в них наравне с VCL появляется новая библиотека элементов управления: FireMonkey. FireMonkey вынуждена строить своё, полностью изолированное дерево наследования, во многом повторяющее дерево наследования VCL:

(Примечание: хотя на этом рисунке есть и TControl и TButton — как и на предыдущем, но надо понимать, что это — совершенно другие классы, которые не имеют ничего общего. Они просто имеют одинаковое имя.)

Подобные несуразности легко решаются интерфейсами. Интерфейс — это контракт в чистом виде, без реализации. Иными словами, главное отличие класса от интерфейса — в том, что класс состоит из интерфейса и реализации. Это означает, что к интерфейсу мы можем легко присоединить любую реализацию — а это и есть полиморфизм. Ключевой фактор здесь — единственная сущность (для ООП — объект) может реализовывать сколько угодно интерфейсов. Вот пример из иерархии Delphi:

Иными словами, если бы VCL и FireMonkey были бы написаны на интерфейсах, то вместо дерева наследования у нас был бы набор интерфейсов вроде:

type
  IPositionableControl = interface
  ['{4E916E73-AC46-4634-BE93-BD95B5ACB083}']
    function GetBounds: TRect;
    procedure SetBounds(const AValue: TRect);
    property Bounds: TRect read GetBounds write SetBounds;
  end;
  
  ICaptionableControl = interface
  ['{7254A2E7-15D2-4374-BB22-7EED602B687B}']
    function GetText: String;
    procedure SetText(const AValue: String);
    property Text: String read GetText write SetText;
  end;

  IVisualControl = interface
  ['{EAC5B888-CA54-4342-BC6A-9D4404C0C0CE}']
    procedure Draw;
  end;

  IClickableControl= interface
  ['{EAC5B888-CA54-4342-BC6A-9D4404C0C0CE}']
    function GetClick: TNotifyEvent;
    procedure SetClick(const AValue: TNotifyEvent);
    procedure OnClick: TNotifyEvent read GetClick write SetClick;
  end;

  IWinControl = interface
  ['{9D1D9651-D473-4BDB-A77F-641D4399DF76}']
    function GetBounds: HWND;
    property Handle: HWND read GetHandle;
  end;

  ICrossPlatformControl = interface
  ['{9D1D9651-D473-4BDB-A77F-641D4399DF76}']
    function GetBounds: Pointer;
    property Handle: Pointer read GetHandle;
  end;

  ICustomControl = interface
  ['{2DF08C79-6DD1-4E90-810B-FD311C8BFA3F}']
    function GetCanvas: TCanvas;
    property Canvas: TCanvas read GetCanvas;
  end;

Тогда TButton от VCL реализовывал бы IPositionableControl, ICaptionableControl, IVisualControl, IClickableControl и IWinControl, но не ICrossPlatformControl и не ICustomControl. TSpeedButton из VCL реализовывал бы IPositionableControl, ICaptionableControl, IVisualControl, IClickableControl и ICustomControl, но не IWinControl и не ICrossPlatformControl. А TButton от FireMonkey — IPositionableControl, ICaptionableControl, IVisualControl, IClickableControl и ICrossPlatformControl, но не IWinControl и не ICustomControl.

Это добавляет в код высокую степень полиморфизма, т.к. теперь все кнопки становятся кнопками — вне зависимости от того, из VCL они или из FireMonkey, оконные они или нет. Теперь можно писать код, который работает с кнопками вообще (например, щёлкает по ним). И он (код) будет одинаков для любых библиотек и любых реализаций.

К сожалению, изначально VCL была написана в те времена, когда интерфейсов в языке Delphi не существовало. Поэтому она и FireMonkey написаны на объектах (обе библиотеки разделяют некоторые общие части). Тем не менее, в своём коде от нас никто не требует использовать именно объекты, так что мы можем писать гибкий (полиморфный) код, используя интерфейсы.

Для начала вам нужно описать сам интерфейс. По аналогии с примером для виртуальных методов:

type
  IMyControl = interface
  ['{FAFE2359-4D4D-42BB-89EC-2300E3E22FAC}']
    function GetBounds: TRect;
    procedure SetBounds(const AValue: TRect);
    function GetText: String; 
    procedure SetText(const AValue: String);

    property Bounds: TRect read GetBounds write SetBounds;
    property Text: String read GetText write SetText;
    procedure Draw; 
  end;

У интерфейсов каждый метод всегда обязательно является виртуальным и абстрактным — поэтому нам не нужно использовать никаких дополнительных ключевых слов.

Далее необходимо интерфейс реализовать. Реализацию интерфейса в Delphi синтаксически удобно делать классом.

type
  TMyButton = class(TObject, IMyControl)
  public
    // IInterface
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    // IMyControl
    function GetBounds: TRect;
    procedure SetBounds(const AValue: TRect);
    function GetText: String; 
    procedure SetText(const AValue: String);
    procedure Draw; 
  end;

Из этого кода можно отметить несколько моментов:

1. Как любой класс автоматически наследуется от TObject, так любой интерфейс автоматически наследуется от IInterface (он же — IUnknown).
2. Каждый класс обязан реализовывать все методы интерфейсов. Это означает, что для упрощения жизни и следования принципу DRY (Don’t Repeat Yourself — «не повторяйся»), нам имеет смысл сделать базовый класс, куда мы вынесем общий код.
3. Метод может находится в любой секции объекта. Как правило методы делают public или protected.
4. Метод не обязан быть виртуальным.

С учётом сказанного мы приходим к:

type
  TMyControl = class(TInterfacedObject)
  private
    FBounds: TRect;
    FText: String;
  protected
    function GetBounds: TRect;
    procedure SetBounds(const AValue: TRect);
    function GetText: String; 
    procedure SetText(const AValue: String);

    procedure Draw; virtual; abstract;
  end;

  TMyButton = class(TMyControl, IMyControl)
  protected
    procedure Draw; override; 
  end;

  TMyEdit = class(TMyControl, IMyControl)
  public 
    procedure Draw; override;
  end;

  TMyLabel = class(TMyControl, IMyControl)
  public 
    procedure Draw; override;
  end;

Обратите внимание, что метод Draw сделан абстрактным и виртуальным только по той причине, что его вызывают другие методы TMyControl. Если же вам его вызывать не нужно, то из класса TMyControl его можно убрать. Полиморфизм в данном случае заключается не в использовании слова virtual, а в проецировании реализаций на интерфейс. Возможно, что более наглядно это будет видно в таком примере:

type
  TMyButton = class(TInterfacedObject, IMyControl)
    function GetBounds: TRect;
    procedure SetBounds(const AValue: TRect);
    function GetText: String; 
    procedure SetText(const AValue: String);
    procedure Draw;
  end;

  TMyButton2 = class(TMyButton, IMyControl)
    procedure Draw;
  end;

  TMyButton3 = class(TMyButton, IMyControl)
    procedure Draw;
  end;

var
  Control: IMyControl;
begin
  Control := TMyButton.Create;
  Control.Draw; // вызывает TMyButton.Draw

  Control := TMyButton1.Create;
  Control.Draw; // вызывает TMyButton1.Draw 

  Control := TMyButton2.Create;
  Control.Draw; // вызывает TMyButton2.Draw 
end;

Впрочем иногда бывает удобнее использовать и виртуальные методы:

type
  TMyButton = class(TInterfacedObject, IMyControl)
    function GetBounds: TRect; virtual; 
    procedure SetBounds(const AValue: TRect); virtual; 
    function GetText: String; virtual; 
    procedure SetText(const AValue: String); virtual; 
    procedure Draw; virtual; 
  end;

  TMyButton2 = class(TMyButton)
    procedure Draw; override;
  end;

  TMyButton3 = class(TMyButton)
    procedure Draw; override;
  end;

var
  Control: IMyControl;
begin
  Control := TMyButton.Create;
  Control.Draw; // вызывает TMyButton.Draw

  Control := TMyButton1.Create;
  Control.Draw; // вызывает TMyButton1.Draw 

  Control := TMyButton2.Create;
  Control.Draw; // вызывает TMyButton2.Draw 
end;

Обратите внимание на отличия:

1. Метод сделан виртуальным и он замещается в наследниках
2. Наследники не указывают определение интерфейса IMyControl

Практические примеры из предыдущей статьи

Помните наглядную иллюстрацию из предыдущей статьи, где входит начальник и отдаёт команду работать? Вот как это могло бы выглядеть на практике:

type
  // Абстрактный работник/сотрудник
  TWorker = class
  public
    procedure Work; virtual; abstract;
  end;

  // Ниже - четыре конкретных сотрудника

  // Секретарь
  TSecretary = class(TWorker)
  public
    procedure Work; override;
  end;

  // Менеджер
  TSalesManager = class(TWorker)
  public
    procedure Work; override;
  end;

  // Юрист
  TLawyer = class(TWorker)
  public
    procedure Work; override;
  end;

  // Программист
  TDeveloper = class(TWorker)
  public
    procedure Work; override;
  end;

  // Начальник (не является работником)
  TBoss = class
  public
    // крикнуть "Работать!"
    procedure ShoutWork;
  end;

procedure TSecretary.Work; 
begin
  // печатать на клавиатуре
end;

procedure TSalesManager.Work;
begin
  // схватиться за телефон
end;

procedure TLawyer.Work;
begin
  // уткнуться в документы
end;

procedure TDeveloper.Work; 
begin
  // тестировать код
end;

var
  // Сотрудники в офисе:
  OfficeWorkers: array of TWorker;

procedure TBoss.ShoutWork;
begin
  for X := 0 to High(OfficeWorkers) do
    OfficeWorkers[X].Work;
end;

Если бы у нас не было бы полиморфизма, то у вас был бы такой код:

type
  // Секретарь
  TSecretary = class
  public
    procedure StartTyping; 
  end;

  // Менеджер
  TSalesManager = class
  public
    procedure GetOnThePhone; 
  end;

  // Юрист
  TLawyer = class
  public
    procedure LookIntoDocuments; 
  end;

  // Программист
  TDeveloper = class
  public
    procedure CreateCode; 
  end;

  // Начальник
  TBoss = class
  public
    // крикнуть "Работать!"
    procedure ShoutWork;
  end;

procedure TSecretary.StartTyping; 
begin
  // печатать на клавиатуре
end;

procedure TSalesManager.GetOnThePhone;
begin
  // схватиться за телефон
end;

procedure TLawyer.LookIntoDocuments;
begin
  // уткнуться в документы
end;

procedure TDeveloper.CreateCode; 
begin
  // тестировать код
end;

var
  Secretaries: array of TSecretary;
  SalesManagers: array of TSalesManager;
  Lawyers: array of TLawyer;
  Developers: array of TDeveloper;

procedure TBoss.ShoutWork;
begin
  for X := 0 to High(Secretaries) do
    Secretaries[X].StartTyping;
  for X := 0 to High(SalesManagers) do
    SalesManagers[X].GetOnThePhone;
  for X := 0 to High(Lawyers) do
    Lawyers[X].LookIntoDocuments;
  for X := 0 to High(Developers) do
    Developers[X].CreateCode;
end;

Впрочем, последний блок кода можно переписать с общим списком так:

var
  Workers: array of TObject;

procedure TBoss.ShoutWork;
begin
  for X := 0 to High(Workers) do
    if Workers[X] is TSecretary then
      TSecretary(Workers[X]).StartTyping
    else
    if Workers[X] is TSalesManager then
      TSalesManager(Workers[X]).GetOnThePhone
    else
    if Workers[X] is TLawyer then
      TLawyer(Workers[X]).LookIntoDocuments
    else
    if Workers[X] is TDeveloper then
      TDeveloper(Workers[X]).CreateCode
    else
      Assert(False);
end;

В любом случае код стал больше и запутанней. В нём стало тяжелее ориентироваться и уже не так ясно, что же происходит. Что ещё хуже: если компания нанимает уборщика, то вам придётся переписать весь код в программе, который работает со списками (или списком) работников, добавив в него код для нового типа сотрудника. В первом же варианте (с полиморфизмом), чтобы нанять в компанию уборщика — вам достаточно создать для него класс и добавить объекты этого класса в список сотрудников. Всё. Никакой код изменять не нужно. Благодаря полиморфизму весь уже написанный код будет уметь работать с уборщиками — просто потому, что он работает с абстрактным понятием: «сотрудник», а не с конкретными представителями.

Из этих примеров хорошо видно, что если:

• У вас есть несколько списков чего-либо и вы пишете код, который проходит по каждому списку…
• Либо у вас есть группа условий вида if ... then ... else if ... then ... else ... (или же case)…

то почти всегда это означает, что в вашем коде есть возможность применить полиморфизм, но вы ею не воспользовались.

Полиморфизм вне ООП

Как уже было сказано — полиморфизм не является эксклюзивным свойством ООП. На самом нижнем уровне полиморфизм заключается в изменении адреса вызова в run-time. Поэтому, конечно же, существуют и способы реализовать полиморфное поведение, не используя ООП. К примеру, в процедурном подходе вы можете использовать указатели на код: процедурные типы.

type
  TOperationProc = function(A, B: Integer): Integer;
var
  Operation: TOperationProc;
...
  C := Operation(A, B);

Здесь, в зависимости от того, что именно содержится в переменной Operation, этот код может произвести сложение, вычитание, умножение или (целочисленное) деление.

К примеру, типичная операция: динамический импорт через GetProcAddress уже иллюстрирует полиморфное поведение. В самом деле, вы импортируете функцию Windows API и она будет работать одинаково на любых системах. Внутренняя реализация может существенно изменится, но вы всегда будете получать желаемый результат.

На это можно посмотреть и с другой стороны. К примеру, программа с плагинами. Через GetProcAddress вы получаете адрес функции плагина. Функция всегда одна, но её действие будет зависеть от плагина. Т.е. поведение функции меняется.

У меня даже есть практический пример для процедурного подхода.

В Delphi есть несколько способов работы с файлами: файлы Паскаля, потоки данных, объекты-оболочки (TStrings). Каждый способ имеет свои достоинства и недостатки. К примеру, достоинства файлов Паскаля:

• Простота работы именно с текстом (форматирование)
• Возможность построчного ввода/вывода
• Буферизация

Недостатки файлов Паскаля иллюстрируются достоинствами файловых потоков:

• Универсальность
• Поддержка BOM и любых кодировок
• Возможность указания режима доступа без использования глобальных переменных (нет проблем в многопоточных приложениях)

К счастью, начиная с Delphi XE2 в RTL появились средства, позволяющие полноценно соединить плюсы каждого из подходов. Что это за средства? В Delphi XE2 файлы Паскаля могут иметь ассоциированную с ними кодовую страницу, которая указывает, в какой кодировке нужно выводить текстовые данные. Среди прочих — поддерживается и UTF8, что позволяет нам полноценно реализовать поддержку Unicode. Теперь можно делать WriteLn('Русский текст') — и это будет работать именно так, как ожидается.

Если вы посмотрите на плюсы и минусы каждого подхода, то увидите, что файлы Паскаля хорошо подходят для внешнего слоя (интерфейса): с ними удобно работать. А файловые потоки хорошо подходят для внутреннего слоя (реализации): они функциональны. Так как же нам соединить их?

Ответ можно найти в структуре (записи) TTextRec:

{ Text file record structure used for Text files }
  PTextBuf = ^TTextBuf;
  TTextBuf = array[0..127] of AnsiChar;

  TTextRec = packed record (* must match the size the compiler generates: 730 bytes (754 bytes for x64) *)
    Handle: NativeInt;       (* must overlay with TFileRec *)
    Mode: Word;
    Flags: Word;
    BufSize: Cardinal;
    BufPos: Cardinal;
    BufEnd: Cardinal;
    BufPtr: PAnsiChar;
    OpenFunc: Pointer;
    InOutFunc: Pointer;
    FlushFunc: Pointer;
    CloseFunc: Pointer;
    UserData: array[1..32] of Byte;
    Name: array[0..259] of WideChar;
    Buffer: TTextBuf;
    CodePage: Word;
    MBCSLength: ShortInt;
    MBCSBufPos: Byte;
    case Integer of
      0: (MBCSBuffer: array[0..5] of AnsiChar);
      1: (UTF16Buffer: array[0..2] of WideChar);
  end;

  TTextIOFunc = function(var F: TTextRec): Integer;

Запись TTextRec представляет собой внутреннюю реализацию текстовых файлов Паскаля. Как вы можете видеть, она содержит в себе указатели на функции:

    OpenFunc: Pointer;
    InOutFunc: Pointer;
    FlushFunc: Pointer;
    CloseFunc: Pointer;

Эти поля объявлены как указатели, но на самом деле трактуются как поля типа TTextIOFunc. К сожалению, тип TTextIOFunc нельзя объявить до TTextRec (поскольку объявление TTextIOFunc использует TTextRec), поэтому тип TTextIOFunc нельзя использовать в полях TTextRec и приходится использовать тип Pointer с последующим приведением типа.

В любом случае, как вы можете уже догадаться, на самом деле процедуры вроде Reset, Rewrite, Write и WriteLn не выполняют реальной работы, а лишь вызывают указанные выше процедуры через указатель — и именно эти процедуры и делают всю работу. Меняя указатели на свои, мы можем изменить поведение текстовых файлов. В этом и будет заключаться полиморфное поведение.

Вся структура TTextRec в целом инициализируется в AssignFile, она же заполняет и указатели на функции. Поэтому всё, что нам нужно сделать — предоставить свою реализацию каждой функции плюс аналог AssignFile, который впишет в структуру TTextRec наши функции, а не стандартные.

Тогда становится возможным такой код (скачать StreamText.pas):

uses
  StreamText;

procedure TForm1.Button1Click(Sender: TObject);
var
  Stream: TFileStream;
  F: TextFile;
  I: Integer;
  X: Extended;
  Buffer: array[0..1023] of Byte;
begin
  I := 5;
  X := 2.5;

  // Пример #1: похоже на классические файлы Паскаля
  Stream := TFileStream.Create('D:Test.txt', fmCreate, fmShareExclusive);
  try
    AssignStream(F, Stream); // вместо AssignFile
    try
      { опционально - для оптимизации скорости } System.SetTextBuf(F, Buffer);
      Rewrite(F); // = открывает с fmOutput

      WriteLn(F, 'Test');
      WriteLn(F, 'Value: ', I, ', Русский Текст: ', X:1:3);
    finally
      CloseFile(F);
    end;
  finally
    FreeAndNil(Stream);
  end;
end;

Или:

uses
  StreamText;

procedure TForm1.Button2Click(Sender: TObject);
var
  Stream: TFileStream;
  F: TextFile;
  S: String;
begin
  Memo1.Lines.Clear;

  // Пример #2: больше аргументов
  Stream := TFileStream.Create('D:Test.txt', fmOpenRead, fmShareExclusive);
  try
    AssignStream(F, Stream, 1024 { опционально: размер буфера }, fmInput { опционально: режим });
    try
      while not EOF(F) do
      begin
        ReadLn(F, S);
        Memo1.Lines.Add(S);
      end;
    finally
      CloseFile(F);
    end;
  finally
    FreeAndNil(Stream);
  end;
end;

Заключение

В этой статье мы рассмотрели несколько практических примеров применения полиморфизма. Мы показали использование виртуальных методов — как основного средства для реализации полиморфизма в ООП. Мы также рассмотрели события и интерфейсы — как частные случаи, призванные упростить реализацию полиморфизма для тех ситуаций, где обычное наследование с виртуальными методами даёт не самый удачный код. Наконец, мы посмотрели на возможности полиморфизма вне ООП — в рамках процедурного подхода.

В последней части серии мы рассмотрим полиморфное поведение кода без использования специальных языковых конструкций ООП или процедурного программирования.

Читать на сайте автора.