Версия для печати


Контейнер визуальных объектов
http://www.delphikingdom.com/asp/viewitem.asp?catalogID=1344

Юрий Спектор
дата публикации 17-04-2008 04:57

Проектирование объектно-ориентированных систем. Пример - "Контейнер визуальных объектов".

Рассмотрим достаточно распространенную практическую задачу: необходимо реализовать визуальный контейнер, на котором размещаются графические объекты. Эти объекты должны быть не только нарисованы на поверхности этого контейнера, но и доступны пользователю для различных манипуляций, таких как выделение, перемещение с помощью мыши и др. Объекты могут быть разнотипными, следовательно, они будут по-разному выглядеть, характеризоваться различными параметрами. Набор операций, которые можно совершать по отношению к ним, также будет различным.

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

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


Рисунок 1. Пример контейнера визуальных объектов - редактор блок-схем.

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

Основные понятия.

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

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

Положение объекта на контейнере характеризуется координатами. Введем два понятия — логические координаты и экранные координаты. Логическими координатами условимся называть координаты объекта или его составных частей (вершины, например) в условной координатной системе контейнера. Например, если контейнер представляет собой шахматную доску, его логический размер будет 8x8 и каждый объект (фигура) будет характеризоваться положением согласно этой координатной системе. Если у нас контейнер - это холст для редактирования блок-схем, то логический размер холста можно задать более произвольно. Например, мы можем принять его равным 200x100 некоторых абстрактных единиц. А можно принять размер в соответствии с физическим размером листа бумаги данного формата в миллиметрах или дюймах. Например, для листа A4 мы можем принять размер 210x297 (размер листа в миллиметрах). Таким образом, каждый объект на контейнере будет характеризоваться определенными координатами, значения которых не зависят от выбранного пользователем масштаба, области просмотра, разрешения экрана и т.д. Напротив, экранными координатами объекта будем называть его смещение в пикселях относительно начала координат компонента, представляющего контейнер. Экранные координаты нам понадобятся при выводе объекта на канве контейнера, логическими же мы будем оперировать во всех остальных случаях, чтобы отделить логику работы системы от отображения на экране. Подобная архитектура, где логика отделена от представления на экране, носит название "паттерн Модель-вид". Очень часто фигурирует еще и третье понятие - "контроллер" - абстрактный слой, соединяющий между собой логику и отображение. Такая архитектура носит название "Модель-вид-контроллер".

Ставим задачу.

Приведем список объектов, которые нам понадобятся для составления блок-схем, опишем их параметры, внешний вид и действия, которые над ними можно совершать.

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

Получается, что положение каждого объекта характеризуется двумя парами координат - верхним левым и нижним правым углом описанного прямоугольника (для всех, кроме линий) или координатами концов (для соединительной линии). Чтобы это нам не упрощало задачу, введем еще один блок, у которого количество вершин может быть произвольным:

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

Объекты в контейнере необходимо также конструировать в позиции, определяемой пользователем. Конструирование всех блоков, кроме "ломаной линии", будет заключаться в последовательном нажатии левой кнопки мыши в двух точках, при этом между этими нажатиями объект уже будет отображаться и "тянуться" за мышью. Ломаная будет конструироваться подобным образом - каждый следующий щелчок мыши будет добавлять вершину в позиции щелчка. Последняя вершина будет также "тянуться" за мышью. Щелчок правой кнопкой будет означать окончание построения.

Кроме координат, все блоки, кроме соединительной и ломаной линии, смогут содержать некоторый текст. Следовательно, к этим блокам добавятся еще один параметр. Для простоты, мы не будем вводить параметр шрифта, но если в этом будет необходимость - реализовать это не составит труда. Также мы для простоты опустим другие настройки внешнего вида, такие как цвет, заливка и прочие.

Итак, подытожим все, что мы определили для объектов.

Параметры: Операции:

Можно было бы ввести и еще некоторые специфичные для объекта операции, такие как управление углом наклона параллелограмма или радиусом закругления блока "начало/конец", однако добавить новые операции не составляет никакого труда и мы, чтобы не загромождать пример, не станем этого делать.

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

Теперь поговорим о параметрах контейнера. Прежде всего, зададимся его логическими размерами. Пусть это будет 210 логических единиц по горизонтали и 297 - по вертикали. Т.е. это размеры вертикально расположенного листа формата A4 в миллиметрах. С помощью мыши мы сможем переместить вершины объекта только в узлы некоторой сетки. Для простоты, примем этот шаг равный одной логической единице. Шаг сетки можно было бы сделать и произвольным, задаваемым пользователем, а можно было бы и не делать сетку вовсе, однако ее наличие упростит выравнивание объектов на контейнере. Объекты ничего не будут знать о сетке, их координаты просто будут задаваться в вещественных числах, которые представляют собой логические координаты. Шаг сетки будет учитываться только при переходе от экранных координат к логическим - при переводи просто будем округлять результат с учетом этого шага.

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

Кроме того, у контейнера можно задать масштаб. При масштабе 100% одной логической единице будет соответствовать один миллиметр.

Как подойти к решению?

Для решения любой сколько-нибудь сложной задачи, ее нужно разбить на более простые части. Потом эти части можно разбить на еще более мелкие части и т.д. Правильно разбить задачу на подзадачи - очень важный этап, не сделав этого, эффективное решение найти крайне проблематично. Именно поэтому, прежде чем садиться за клавиатуру, очень полезно провести некоторое время с карандашом и бумажкой.

Если свалить все в кучу, то реализация нашего контейнера будет представлять собой эдакого неповоротливого монстра, содержащего огромное количество кода, разобраться в котором даже самому программисту, написавшему его, порою не так то просто. При этом если в будущем понадобится расширять систему, добавляя новые объекты или операции над ними, весь этот код придется пересматривать и "перелопачивать". Не самое приятное занятие, чревато занесением кучи ошибок. Рано или поздно этот "монстр" рухнет под своим собственным весом. Так что ни о какой гибкости и масштабируемости построенной таким образом системы говорить не приходится.

Для эффективного решения, целесообразно разбить систему на некие абстрактные блоки, реализующие строго свою часть задачи и определенным образом взаимодействующие между собой. В данном случае, разумно было бы спроектировать контейнер таким образом, чтобы он мог однообразно работать с любыми объектами, не задумываясь об их конкретном типе. А всю специфику поведения конкретных объектов переложить на сами эти объекты. Таким образом, код контейнера станет полиморфным - т.е. обобщенный код, оперирующий некими абстрактными понятиями, конкретное поведение которого зависит от конкретных типов объектов, для которого он выполняется. Написанный однажды, такой код будет работать с любым типом объектов, главное чтобы эти объекты выполняли некоторые предъявляемые к ним требования.

Итак, реализацию поставленной задачи можно разбить на следующие части:

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

Базовый класс объектов.

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

Управление позицией объекта.

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

И базовые точки, и вершины объекта хранят координаты в логических единицах, а конкретная точка или вершина идентифицируется по индексу. Внутренне, объект будет хранить свою позицию в виде списка базовых точек, так как этого вполне достаточно для однозначного определения позиции. Но извне базовые точки будут недоступны. Вместо этого объект будет предоставлять доступ к своим вершинам. Список вершин в объекте специально хранить нет смысла, достаточно "научить" объект возвращать координаты указанной вершины, имея на руках только координаты базовых точек.

Для задания логических координат точек введем тип TFloatPoint. 
type
  // Логические координаты
  PFloatPoint = ^TFloatPoint;
  TFloatPoint = record
     X, Y: Extended;
  end;

Список базовых точек реализуем с помощью класса TList, в котором будем хранить указатели на координаты. Память для этих координат будем выделять и освобождать динамически.

// Базовый класс визуальных объектов
TBaseVisualObject = class(TObject)
private
  FBasePoints: TList;
  FOnChange: TNotifyEvent;
  FLockCount: Integer;
  function GetBasePointsCount: Integer;
  function GetBasePoint(Index: Integer): TFloatPoint;
  procedure SetBasePoint(Index: Integer; const Value: TFloatPoint);
protected
  procedure Change;
  // Методы управления базовыми точками. Только для использования в потомках,
  // клиентскому коду они не доступны
  procedure AddBasePoint(X, Y: Extended);
  procedure InsertBasePoint(Index: Integer; X, Y: Extended);
  procedure DeleteBasePoint(Index: Integer);
  procedure ClearBasePoints;
  property BasePointsCount: Integer read GetBasePointsCount;
  property BasePoints[Index: Integer]: TFloatPoint read GetBasePoint
    write SetBasePoint;
  // Методы управления вершинами. Соответствие между вершинами и базовыми точками
  // будет задано в потомках
  function GetVertexesCount: Integer; virtual; abstract;
  function GetVertex(Index: Integer): TFloatPoint; virtual; abstract;
  procedure SetVertex(Index: Integer; const Value: TFloatPoint); virtual; abstract;
public
  constructor Create;
  destructor Destroy; override;
  // Методы блокировки/разблокировки
  procedure BeginUpdate;
  procedure EndUpdate;
  // Свойства/события
  property VertexesCount: Integer read GetVertexesCount;
  property Vertex[Index: Integer]: TFloatPoint read GetVertex write SetVertex;
  property OnChange: TNotifyEvent read FOnChange write FOnChange;
end;

...
implementation

{ TBaseVisualObject }

procedure TBaseVisualObject.AddBasePoint(X, Y: Extended);
var
  NewBasePoint: PFloatPoint;
begin
  // Выделяем память под новую точку и добавляем указатель на нее в список
  New(NewBasePoint);
  NewBasePoint^.X := X;
  NewBasePoint^.Y := Y;
  FBasePoints.Add(NewBasePoint);
  Change;
end;

procedure TBaseVisualObject.BeginUpdate;
begin
  Inc(FLockCount);
end;

procedure TBaseVisualObject.Change;
begin
  if Assigned(FOnChange) and (FLockCount = 0) then
    FOnChange(Self);
end;

procedure TBaseVisualObject.ClearBasePoints;
var
  i: Integer;
begin
  // Освобождаем память под базовые точки и очищаем список от указателей на них
  for i := 0 to FBasePoints.Count - 1 do
    Dispose(PFloatPoint(FBasePoints[i]));
  FBasePoints.Clear;
  Change;
end;

constructor TBaseVisualObject.Create;
begin
  inherited Create;
  FBasePoints := TList.Create;
end;

procedure TBaseVisualObject.DeleteBasePoint(Index: Integer);
begin
  // Освобождаем память, выделенную для хранения координат базовых точек, и удаляем
  // указатель из списка
  Dispose(PFloatPoint(FBasePoints[Index]));
  FBasePoints.Delete(Index);
  Change;
end;

destructor TBaseVisualObject.Destroy;
var
  i: Integer;
begin
  // Перед уничтожением списка, освобождаем память под вершины
  for i := 0 to FBasePoints.Count - 1 do
    Dispose(PFloatPoint(FBasePoints[i]));
  FBasePoints.Free;
  inherited Destroy;
end;

procedure TBaseVisualObject.EndUpdate;
begin
  FLockCount := Max(0, FLockCount - 1);
  if FLockCount = 0 then
    Change;
end;

function TBaseVisualObject.GetBasePoint(Index: Integer): TFloatPoint;
begin
  Result := PFloatPoint(FBasePoints[Index])^;
end;

function TBaseVisualObject.GetBasePointsCount: Integer;
begin
  Result := FBasePoints.Count;
end;

procedure TBaseVisualObject.InsertBasePoint(Index: Integer; X, Y: Extended);
var
  NewBasePoint: PFloatPoint;
begin
  // Выделяем память под новую точку и добавляем указатель на нее в список
  New(NewBasePoint);
  NewBasePoint^.X := X;
  NewBasePoint^.Y := Y;
  FBasePoints.Insert(Index, NewBasePoint);
  Change;
end;

procedure TBaseVisualObject.SetBasePoint(Index: Integer;
  const Value: TFloatPoint);
begin
  PFloatPoint(FBasePoints[Index])^ := Value;
  Change;
end;

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

Управление вершинами осуществляется через свойство Vertex[Index], причем методы получения/установки свойства созданы виртуальными и абстрактными. В зависимости от типа объекта, мы напишем соответствующую реализацию этих методов, которые будут связывать между собой вершины с базовыми точками.

Также стоит обратить внимание на метод Change. Этот метод вызывается при любом изменении состояния объекта. В нем проверяется, назначен ли обработчик события OnChange, и если да, и при этом не было блокировок - то вызывает этот обработчик. Его можно использовать для того, чтобы клиентский код мог отреагировать на изменение объектов (например, вызвать перерисовку объектов с учетом измененных параметров). Методы блокировок BeginUpdate и EndUpdate будем использовать тогда, когда нужно временно запретить вызывать обработчик OnChange, в частности, когда изменений состояния объекта планируется много, но при этом нет смысла каждый раз вызывать OnChange - достаточно одного вызова в конце. Вызов BeginUpdate увеличивает на 1 счетчик блокировок, а EndUpdate - соответственно уменьшает, при этом, не давая ему принять отрицательное значение - т.н. "защита от дурака". Если в результате снятия блокировки счетчик стал равен 0 (все блокировки сняты), то вызывается метод Change чтобы позволить вызывающему коду отреагировать на изменения.

Механизмы обработки операций.

Для осуществления операций над объектами, необходимо каким-либо образом отправить ему команду, которая будет содержать код конкретной операции, а также некоторый набор параметров. Объект, получив эту команду, соответствующим образом на нее отреагирует. Очень напоминает механизм, по которому окна в Window получают и обрабатывает сообщения. Было бы удобно описать методы с директивой message, для обработки каждого конкретного типа операции, а потом просто отправлять объекту сообщения. К тому же, для добавления новых типов команд не пришлось бы сильно переделывать всю архитектуру, достаточно было бы у нужных классов добавить обработчик нового сообщения. Однако наши объекты не являются окнами Windows. Как быть?

Ответ заключается в том, что в Delphi методы с директивой message можно описывать у любых классов, не обязательно у оконных элементов управления. Метод Dispatch, который позволяет находить и вызывать такие методы, реализован в классе TObject. Нам остается только добавить в класс метод, назвав его, скажем, SendCommand, принимающий идентификатор и параметры сообщения, а в реализации этого метода просто вызывать Dispatch. Теперь вызов SendCommand будет приводить к вызову метода, описанного директивой message, соответствующего идентификатору отправляемого сообщения. Сделаем это.

TBaseVisualObject = class(TObject)
...
public
...
  // Отправка команды
  function SendCommand(ID: Cardinal; wParam, lParam: Longint): Longint;
...
end;

implementation

...
function TBaseVisualObject.SendCommand(ID: Cardinal; wParam,
  lParam: Longint): Longint;
var
  Message: TMessage;
begin
  Message.Msg := ID;
  Message.WParam := wParam;
  Message.LParam := lParam;
  Dispatch(Message);
  Result := Message.Result;
end;

Некоторые операции и их обработку можно определить еще в базовом классе. В потомках, при необходимости, мы всегда сможем перекрыть это поведение своим. В базовом же классе определим следующие операции:

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

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

const
  // Области объектов
  HT_OUT          = $00000000;         // Вне объекта
  HT_IN           = $80000000;         // Внутренняя область
  HT_VERTEX       = $40000000;         // Вершина
  HT_SIDE         = $20000000;         // Сторона

Индекс вершины и стороны будет прибавляться соответственно к константам HT_VERTEX и HT_SIDE. Теперь определимся с типами и параметрами сообщений.

const
  ...
  // Команды объектов
  VOC_BEGINDRAG   = 1;
  VOC_ENDDRAG     = 2;
  VOC_DRAG        = 3;
  VOC_VERTEXMOVE  = 4;
  VOC_SIDEMOVE    = 5;
  VOC_MOVE        = 6;

type
  ...
  // Начало перетаскивания или растягивания мышью
  TVOCBeginDrag = packed record
    CmdID: Cardinal;
    HitTest: Cardinal;      // Область объекта
    StartPos: PFloatPoint;  // Позиция, в которой началось перетаскивание
    Result: Longint;
  end;

  // Завершение перетаскивания или растягивания мышью
  TVOCEndDrag = packed record
    CmdID: Cardinal;
    Unused1: Longint;       // Не используется
    Unused2: Longint;       // Не используется
    Result: Longint;
  end;

  // Перетаскивание или растягивание мышью
  TVOCDrag = packed record
    CmdID: Cardinal;
    Unused: Longint;      // Не используется
    NewPos: PFloatPoint;  // Позиция, в которую переместилась мышь
    Result: Longint;
  end;

  // Перемещение вершины
  TVOCVertexMove = packed record
    CmdID: Cardinal;
    Index: Integer;       // Индекс вершины
    NewPos: PFloatPoint;  // Новая позиция вершины
    Result: Longint;
  end;

  // Перемещение стороны
  TVOCSideMove = packed record
    CmdID: Cardinal;
    Index: Integer;       // Индекс стороны
    NewPos: PFloatPoint;  // Новая позиция стороны
    Result: Longint;
  end;

  // Перемещение вершины
  TVOCMove = packed record
    CmdID: Cardinal;
    DeltaX: PExtended;    // Смещение по оси X
    DeltaY: PExtended;    // Смещение по оси Y
    Result: Longint;
  end;

Реализуем в базовом классе обработчики этих команд по умолчанию. Метод обработки VOC_SIDEMOVE в базовом классе реализовывать не будем, поведение объектов при получении этой команды определим у потомков.

type
...
  TBaseVisualObject = class(TObject)
  private
    ...
    FDragging: Boolean;
    FDragHitTest: Cardinal;
    FDragStartPos: TFloatPoint;
    ...
    procedure VOCBeginDrag(var Command: TVOCBeginDrag); message VOC_BEGINDRAG;
    procedure VOCEndDrag(var Command: TVOCEndDrag); message VOC_ENDDRAG;
    procedure VOCDrag(var Command: TVOCDrag); message VOC_DRAG;
    procedure VOCVertexMove(var Command: TVOCVertexMove); message VOC_VERTEXMOVE;
    procedure VOCMove(var Command: TVOCMove); message VOC_MOVE;
  ...
implementation
...
procedure TBaseVisualObject.VOCBeginDrag(var Command: TVOCBeginDrag);
begin
  FDragging := True;
  FDragHitTest := Command.HitTest;
  FDragStartPos := Command.StartPos^;
end;

procedure TBaseVisualObject.VOCDrag(var Command: TVOCDrag);
var
  HitTest: Cardinal;
  Index: Integer;
  DeltaX, DeltaY: Extended;
begin
  if FDragging then begin
    // Раскладываем FDragHitTest на общий код области и индекс
    HitTest := FDragHitTest and $FFFF0000;
    Index := FDragHitTest and $0000FFFF;
    // В зависимости от того, над какой областью мышь, посылаем различные
    // команды
    case HitTest of
      HT_IN:
        begin
          // Определяем величину смещения
          DeltaX := Command.NewPos^.X - FDragStartPos.X;
          DeltaY := Command.NewPos^.Y - FDragStartPos.Y;
          // В следующий раз смещение будем считать от текущей позиции
          FDragStartPos := Command.NewPos^;
          SendCommand(VOC_MOVE, Longint(@DeltaX), Longint(@DeltaY));
        end;
      HT_VERTEX: SendCommand(VOC_VERTEXMOVE, Index, Longint(Command.NewPos));
      HT_SIDE: SendCommand(VOC_SIDEMOVE, Index, Longint(Command.NewPos));
    end;
  end;
end;

procedure TBaseVisualObject.VOCEndDrag(var Command: TVOCEndDrag);
begin
  FDragging := False;
end;

procedure TBaseVisualObject.VOCMove(var Command: TVOCMove);
var
  i: Integer;
  Pos: TFloatPoint;
begin
  BeginUpdate;
  try
    // Перемещаем все базовые точки на величину смещения
    for i := 0 to BasePointsCount - 1 do begin
      Pos := BasePoints[i];
      Pos.X := Pos.X + Command.DeltaX^;
      Pos.Y := Pos.Y + Command.DeltaY^;
      BasePoints[i] := Pos;
    end;
  finally
    EndUpdate;
  end;
end;

procedure TBaseVisualObject.VOCVertexMove(var Command: TVOCVertexMove);
begin
  Vertex[Command.Index] := Command.NewPos^;
end;

Прорисовка объекта.

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

Реализуем класс TLogicalCanvas, который будет представлять собой что-то вроде моста из логической системы координат в экранные. Объект будет рисовать себя, вызывая методы TLogicalCanvas, которые в качестве параметров принимают логические координаты, а уже внутри этих методов будет идти трансляция и прорисовка на TCanvas. Это добавит нашей системе дополнительную гибкость. Например, мы можем в классе TLogicalCanvas реализовать методы рисования виртуальными, объявить у класса потомки и там их перекрыть. Например, в одном потомке будут рисоваться простые линии и фигуры на двумерном холсте. В другом потомке - они могут быть изображены, например, в трехмерном пространстве. Именно для редактора блок-схем, такое поведение, разумеется, не нужно, но под понятие "контейнер визуальных объектов" попадает достаточно много задач, а в некоторых из них это может понадобиться. Зато в нашем случае, мы сможем не перекладывать на объект полностью ответственность за свой вид, а лишь сказать ему, из каких составных частей он состоит. Сами эти составные части могут выглядеть иначе, и мы сможем гибко этим управлять, например, нам не составит труда в одном случае обозначать у объекта вершины квадратами, в другом - кругами, а в третьем - и вовсе не обозначать, а строить объект только из линий. При добавлении нового способа отображения, менять код самого объекта не придется. Снова модель и вид отделены друг от друга. Однако реализовывать потомки TLogicalCanvas мы не станем, а данный класс введем чисто для демонстрации описанного выше подхода.

Как уже было сказано выше, класс TLogicalCanvas должен уметь переходить из одной системы координат в другую. Однако закладывать эту возможность в сам класс смысла мало. Дело в том, что перевод из одной системы координат в другую может понадобится не только для рисования объектов, но и, скажем, при определении области объекта под курсором мыши. Очевидно, что код преобразования координат в этих случаях должен быть идентичным и его нет смысла дублировать. Выходит, что TLogicalCanvas должен обращаться к какому-либо внешнему объекту (предположительно - контейнеру) для того, чтобы вызвать его методы преобразования координат. Не совсем красивое решение - некий абстрактный класс, представляющий собой холст, должен что-то знать о конкретном классе, который такие преобразования может осуществлять. К тому же, нам не нужна вся функциональность этого конкретного класса, а только лишь методы преобразования координат.

Тут следует вспомнить об одной возможности языка, которая в данном случае может пригодиться - интерфейсы. Интерфейс представляет собой простое описание методов, реализацию которых должен взять на себя класс. Когда методы интерфейса в классе реализованы (не важно в каком), мы можем привести экземпляр этого класса к интерфейсному типу и передать полученную интерфейсную ссылку туда, где эти методы могут понадобиться. Зная только описание интерфейса, можно вызывать его методы, при этом, совершенно не задумываясь о прочих кроме самого интерфейса сущностях. Очень удобно получается - класс TLogicalCanvas не знает, кто именно и каким образом реализует методы преобразования координат, но ему предоставлена возможность эти методы вызывать.

Объявим интерфейс, в котором определим методы перевода из логических единиц в экранные и наоборот.

type
  // Интерфейс для преобразования координат
  ICoordConvert = interface(IInterface)
    procedure LogToScreen(lX, lY: Extended; var sX, sY: Integer); overload;
    procedure ScreenToLog(sX, sY: Integer; var lX, lY: Extended); overload;
    function LogToScreen(Value: Extended): Integer; overload;
    function ScreenToLog(Value: Integer): Extended; overload;
  end;

Тут следует пояснить. Мы определили две пары методов с одинаковыми названиями, но разным набором параметров. Первая пара методов принимает в качестве параметров координаты точки в одной системе и возвращает в другой. Будучи реализованы в контейнере, эти методы будут сильно зависеть от его состояния - выбранного масштаба, видимой в компоненте области, которая задается положением скроллбаров. Вторая же пара методов, по сути, зависит только от выбранного масштаба. Эти методы будут возвращать не абсолютные координаты точки, а просто переводить (в нашем случае) пиксели в миллиметры и наоборот. Нам пригодятся обе пары методов.

При создании экземпляра TLogicalCanvas будем передавать ему параметр типа ICoordConvert, с помощью которого и будут осуществляться координатные преобразования.

Для примера покажем, как в этом классе будет реализован метод, рисующий отрезок. Реализация рисования других примитивов принципиально ничем не отличается.

type
  // Логический холст
  TLogicalCanvas = class(TObject)
  private
    FCanvas: TCanvas;
    FConvertIntf: ICoordConvert;
  public
    constructor Create(Canvas: TCanvas; ConvertIntf: ICoordConvert);
    // Методы рисования
    procedure DrawLine(X1, Y1, X2, Y2, LineWidth: Extended);
    ... {будут и другие методы для рисования}
  end;

implementation

{ TLogicalCanvas }

constructor TLogicalCanvas.Create(Canvas: TCanvas;
  ConvertIntf: ICoordConvert);
begin
  inherited Create;
  FCanvas := Canvas;
  FConvertIntf := ConvertIntf;
end;

procedure TLogicalCanvas.DrawLine(X1, Y1, X2, Y2, LineWidth: Extended);
var
  sX1, sY1, sX2, sY2: Integer;
begin
  // Переход в экранные координаты
  FConvertIntf.LogToScreen(X1, Y1, sX1, sY1);
  FConvertIntf.LogToScreen(X2, Y2, sX2, sY2);
  // Ширина линии
  FCanvas.Pen.Width := FConvertIntf.LogToScreen(LineWidth);
  // Рисуем
  FCanvas.MoveTo(sX1, sY1);
  FCanvas.LineTo(sX2, sY2);
end;

Тут все достаточно просто и очевидно, в подробных комментариях нет нужды. В методы рисования передаются параметры в логических единицах, в этих методах осуществляется переход в экранные координаты и вывод на канву, которую мы указали в конструкторе.

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

TBaseVisualObject = class(TObject)
...
public
 ...
  // Рисование
  procedure Draw(Canvas: TLogicalCanvas); virtual;
...
implementation
...
procedure TBaseVisualObject.Draw(Canvas: TLogicalCanvas);
var
  i: Integer;
begin
  // Рисуем вершины
  for i := 0 to VertexesCount - 1 do
    Canvas.DrawVertex(Vertex[i].X, Vertex[i].Y);
end;

Определение области объекта в точке.

Хорошо, а как клиентский код определит, какая область объекта находится под указателем мыши? Объект должен иметь метод, принимающий координаты в качестве параметров, и возвращающий код области. Причем нужно учесть, что пользователю весьма проблематично подвести курсор мыши прямо на вершину, и поэтому некоторые ее окрестности также должны восприниматься, как вершина. То же касается и сторон. И снова, необходимо учесть, что координаты мыши задаются в экранных единицах, а объект знает свое положение только в физических координатах. Значит, для этого действия нам снова придется использовать ранее введенный интерфейс.

Данную операцию также можно реализовать в качестве команды. Ее обработчик в базовом классе будет просто возвращать HT_OUT, а уже в конкретных потомках мы перекроем эту операцию, чтобы объект правильно сообщал свои области в точках.

Кроме того, при действиях над объектом с помощью мыши, в зависимости от того, над какой его частью находятся мышь, необходимо соответствующим образом менять вид курсора. Можно ввести еще одну команду, в которую передается код области в качестве параметра, а результатом возвращается идентификатор курсора. Для идентификации курсора в Delphi есть специальный тип - TCursor. Однако мы не будем однозначно "зашивать" в объекты вид курсора, логично было бы оставить эту возможность использующему объект контейнеру. В объекте мы будем формировать свой независимый код курсора, а уж контейнер пусть делает с ним что захочет. Например, принимает различную форму курсора для разных кодов, или один общий вид курсора (скажем, в форме руки) для всех.

const
  ...
  // Виды курсора
  CR_DEFAULT      = 0;
  CR_SIZEALL      = 1;
  CR_HORIZONTAL   = 2;
  CR_VERTICAL     = 3;
  CR_DIAG1        = 4;
  CR_DIAG2        = 5;
  ...
  VOC_HITTEST     = 7;
  VOC_GETCURSOR   = 8;

type
  // Параметры для определения области объекта
  PHitTestParams = ^THitTestParams;
  THitTestParams = record
    XPos, YPos: Integer;  // Позиция в экранных единицах
    Tolerance: Integer;   // Чувствительность
  end;
  ...
  // Определение области объекта
  TVOCHitTest = packed record
    CmdID: Cardinal;
    ConvertIntf: ICoordConvert; // Интерфейс преобразования координат
    Params: PHitTestParams;     // Параметры
    Result: Cardinal;
  end;

  // Определение вида курсора
  TVOCGetCursor = packed record
    CmdID: Cardinal;
    Unused: Longint;      // Не используется
    HitTest: Cardinal;    // Область объекта
    Result: Cardinal;
  end;

  // Базовый класс визуальных объектов
  TBaseVisualObject = class(TObject)
  private
    ...
    procedure VOCHitTest(var Command: TVOCHitTest); message VOC_HITTEST;
...
implementation
...

procedure TBaseVisualObject.VOCGetCursor(var Command: TVOCGetCursor);
begin
  Command.Result := CR_DEFAULT;
end;

procedure TBaseVisualObject.VOCHitTest(var Command: TVOCHitTest);
begin
  Command.Result := HT_OUT;
end;

Конструирование объекта пользователем.

Для конструирования объектов также имеет смысл определить несколько новых команд:
VOC_CONSTRUCTPOINT
- будем вызывать при щелчке левой кнопкой мыши в режиме конструирования. Обработка данной команды будет фиксировать очередную точку объекта. Причем, если результатом команда вернет ноль, это будет признаком того, что конструирование объекта закончено.
VOC_PROCESSCONSTRUCT
- эту команду будем отправлять в режиме конструирования при перемещении мыши между нажатиями. Она нужна для того, чтобы обновить позицию объекта с учетом текущего положения курсора.
VOC_STOPCONSTRUCT
- будем вызывать при нажатии правой кнопки мыши в режиме конструирования для того, чтобы принудительно его завершить. При этом если результатом команда вернет ноль, это будет означать, что конструирование завершено слишком рано, позиция объекта не задана и его следует уничтожить. Эта возможность поможет нам отменять создание любого объекта по нажатию правой кнопкой мыши. Для ломаной полностью отменить конструирование можно будет только после установки первой вершины, щелчок правой кнопкой после установки последующих вершин просто завершит конструирование. 
const
  ...
  VOC_PROCESSCONSTRUCT  = 10;
  VOC_STOPCONSTRUCT     = 11;
...
type
  ...
  // Добавление точки при конструировании
  TVOCConstructPoint = packed record
    CmdID: Cardinal;
    Unused: Longint;        // Не используется
    Pos: PFloatPoint;       // Позиция новой точки
    Result: Longint;
  end;

  // Конструирование
  TVOCProcessConstruct = packed record
    CmdID: Cardinal;
    Unused: Longint;        // Не используется
    Pos: PFloatPoint;       // Позиция
    Result: Longint;
  end;

  // Завершение конструирования
  TVOCStopConstruct = packed record
    CmdID: Cardinal;
    Unused1: Longint;        // Не используется
    Unused2: Longint;        // Не используется
    Result: Longint;
  end;

Процесс конструирования будет несколько отличаться для разных типов объектов, поэтому с реализацией обработчиков этих команд - повременим.

Что дальше?

Похоже, что с базовым классом мы полностью определились. Пришло время заняться его потомками. Для начала вспомним, какие объекты мы решили реализовать. Можно заметить, что эти объекты можно разделить на две группы:

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

Прямоугольные объекты.

Прежде чем приступить к реализации базового для "прямоугольных" объектов класса, подумаем, что в него можно включить.

Т.е. по сути, потомкам данного класса останется только переопределить собственную реализацию метода Draw.

Зададим соответствие между вершинами и базовыми точками. 
type
  // Базовый класс для "прямоугольных" объектов
  TRectVisualObject = class(TBaseVisualObject)
  protected
    function GetVertexesCount: Integer; override;
    function GetVertex(Index: Integer): TFloatPoint; override;
    procedure SetVertex(Index: Integer; const Value: TFloatPoint); override;
  public
    constructor Create;
  end;
...
implementation
...
{ TRectVisualObject }

constructor TRectVisualObject.Create;
begin
  inherited Create;
  AddBasePoint(0, 0);
  AddBasePoint(0, 0);
end;

function TRectVisualObject.GetVertex(Index: Integer): TFloatPoint;
begin
  // 0 - левый верхний угол
  // 1 - правый верхний угол
  // 2 - правый нижний угол
  // 3 - левый нижний угол
  case Index of
    0: Result := BasePoints[0];
    1:
      begin
        Result.X := BasePoints[1].X;
        Result.Y := BasePoints[0].Y;
      end;
    2: Result := BasePoints[1];
    3:
      begin
        Result.X := BasePoints[0].X;
        Result.Y := BasePoints[1].Y;
      end;
    else
      TList.Error(@SListIndexError, Index);
  end;
end;

function TRectVisualObject.GetVertexesCount: Integer;
begin
  Result := 4;
end;

procedure TRectVisualObject.SetVertex(Index: Integer;
  const Value: TFloatPoint);
var
  Point: TFloatPoint;
begin
  // Устанавливаем новые значения базовым точкам с учетом того, что 0-ая точка
  // всегда должна быть левее и выше 1-ой
  case Index of
    0:
      begin
        Point := BasePoints[0];
        Point.X := Min(Value.X, BasePoints[1].X);
        Point.Y := Min(Value.Y, BasePoints[1].Y);
        BasePoints[0] := Point;
      end;
    1:
      begin
        Point := BasePoints[1];
        Point.X := Max(Value.X, BasePoints[0].X);
        BasePoints[1] := Point;
        Point := BasePoints[0];
        Point.Y := Min(Value.Y, BasePoints[1].Y);
        BasePoints[0] := Point;
      end;
    2:
      begin
        Point := BasePoints[1];
        Point.X := Max(Value.X, BasePoints[0].X);
        Point.Y := Max(Value.Y, BasePoints[0].Y);
        BasePoints[1] := Point;
      end;
    3:
      begin
        Point := BasePoints[0];
        Point.X := Min(Value.X, BasePoints[1].X);
        BasePoints[0] := Point;
        Point := BasePoints[1];
        Point.Y := Max(Value.Y, BasePoints[0].Y);
        BasePoints[1] := Point;
      end;
    else
      TList.Error(@SListIndexError, Index);
  end;
end;

В конструкторе сразу же добавляются две базовые точки в координатах (0; 0). Можно было бы позиционировать объект изначально по-другому, но не суть. Главное то, что больше количество базовых точек нигде меняться не будет. А вот их положение можно изменить, перемещая вершины или стороны объекта. Когда мы меняем положение вершины, вызывается метод SetVertex, который вызывает соответствующее изменение позиций базовых точек. Если при изменении положения 0-й или 2-й вершины нам нужно просто переместить соответственно 0-ю и 1-ю базовую точку, то с 1-й и 3-й вершиной ситуация несколько сложнее. В последнем случае нам нужно поменять по одной координате у двух базовых точек. Метод GetVertex, соответственно, ничего не меняет, а просто возвращает позицию вершины с заданным индексом, высчитывая ее из позиции базовых точек.

Определим действия по растягиванию объекта за его сторону: 
type
  // Базовый класс для "прямоугольных" объектов
  TRectVisualObject = class(TBaseVisualObject)
  private
    procedure VOCSideMove(var Command: TVOCSideMove); message VOC_SIDEMOVE;
  ...
  end;
...
implementation
...
{ TRectVisualObject }
...
procedure TRectVisualObject.VOCSideMove(var Command: TVOCSideMove);
var
  Point: TFloatPoint;
begin
  // 0 - левая сторона
  // 1 - верхняя сторона
  // 2 - правая сторона
  // 3 - нижняя сторона
  case Command.Index of
    0:
      begin
        Point := Vertex[0];
        Point.X := Command.NewPos^.X;
        Vertex[0] := Point;
      end;
    1:
      begin
        Point := Vertex[0];
        Point.Y := Command.NewPos^.Y;
        Vertex[0] := Point;
      end;
    2:
      begin
        Point := Vertex[2];
        Point.X := Command.NewPos^.X;
        Vertex[2] := Point;
      end;
    3:
      begin
        Point := Vertex[2];
        Point.Y := Command.NewPos^.Y;
        Vertex[2] := Point;
      end;
  else
    TList.Error(@SListIndexError, Command.Index);
  end;
end;

Перемещение стороны (происходит при получении команды VOC_SIDEMOVE) реализовано таким образом, что мы просто в зависимости от индекса стороны перемещаем по одной оси одну из вершин. Например, при перемещении левой стороны мы просто меняем значение по оси X левой верхней вершины. С таким же успехом можно было бы перемещать по оси X и левую нижнюю вершину.

Теперь научим объекты отзываться на запрос области под курсором и формы курсора в области:

type
  // Базовый класс для "прямоугольных" объектов
  TRectVisualObject = class(TBaseVisualObject)
  private
    ...
    procedure VOCHitTest(var Command: TVOCHitTest); message VOC_HITTEST;
    procedure VOCGetCursor(var Command: TVOCGetCursor); message VOC_GETCURSOR;
  ...
  end;
...
implementation
...
{ TRectVisualObject }
...
procedure TRectVisualObject.VOCGetCursor(var Command: TVOCGetCursor);
begin
  case Command.HitTest of
    HT_IN: Command.Result := CR_SIZEALL;
    HT_VERTEX + 0, HT_VERTEX + 2: Command.Result := CR_DIAG1;
    HT_VERTEX + 1, HT_VERTEX + 3: Command.Result := CR_DIAG2;
    HT_SIDE + 0, HT_SIDE + 2: Command.Result := CR_HORIZONTAL;
    HT_SIDE + 1, HT_SIDE + 3: Command.Result := CR_VERTICAL;
  else
    Command.Result := CR_DEFAULT;
  end;
end;

procedure TRectVisualObject.VOCHitTest(var Command: TVOCHitTest);
var
  sX1, sY1, sX2, sY2: Integer;
begin
  // Переводим в экранные координаты
  Command.ConvertIntf.LogToScreen(BasePoints[0].X, BasePoints[0].Y, sX1, sY1);
  Command.ConvertIntf.LogToScreen(BasePoints[1].X, BasePoints[1].Y, sX2, sY2);
  // Выявляем область в точке
  Command.Result := HT_OUT;
  if (Abs(Command.Params.XPos - sX1) <= Command.Params.Tolerance) and
     (Abs(Command.Params.YPos - sY1) <= Command.Params.Tolerance)
  then begin
    // Вершина 0
    Command.Result := HT_VERTEX + 0;
    Exit;
  end;
  if (Abs(Command.Params.XPos - sX2) <= Command.Params.Tolerance) and
     (Abs(Command.Params.YPos - sY1) <= Command.Params.Tolerance)
  then begin
    // Вершина 1
    Command.Result := HT_VERTEX + 1;
    Exit;
  end;
  if (Abs(Command.Params.XPos - sX2) <= Command.Params.Tolerance) and
     (Abs(Command.Params.YPos - sY2) <= Command.Params.Tolerance)
  then begin
    // Вершина 2
    Command.Result := HT_VERTEX + 2;
    Exit;
  end;
  if (Abs(Command.Params.XPos - sX1) <= Command.Params.Tolerance) and
     (Abs(Command.Params.YPos - sY2) <= Command.Params.Tolerance)
  then begin
    // Вершина 3
    Command.Result := HT_VERTEX + 3;
    Exit;
  end;
  if (Abs(Command.Params.XPos - sX1) <= Command.Params.Tolerance) and
     (Command.Params.YPos > sY1) and (Command.Params.YPos < sY2)
  then begin
    // Сторона 0
    Command.Result := HT_SIDE + 0;
    Exit;
  end;
  if (Abs(Command.Params.YPos - sY1) <= Command.Params.Tolerance) and
     (Command.Params.XPos > sX1) and (Command.Params.XPos < sX2)
  then begin
    // Сторона 1
    Command.Result := HT_SIDE + 1;
    Exit;
  end;
  if (Abs(Command.Params.XPos - sX2) <= Command.Params.Tolerance) and
     (Command.Params.YPos > sY1) and (Command.Params.YPos < sY2)
  then begin
    // Сторона 2
    Command.Result := HT_SIDE + 2;
    Exit;
  end;
  if (Abs(Command.Params.YPos - sY2) <= Command.Params.Tolerance) and
     (Command.Params.XPos > sX1) and (Command.Params.XPos < sX2)
  then begin
    // Сторона 1
    Command.Result := HT_SIDE + 3;
    Exit;
  end;
  if (Command.Params.XPos > sX1) and (Command.Params.XPos < sX2) and
     (Command.Params.YPos > sY1) and (Command.Params.YPos < sY2)
  then begin
    // Внутри
    Command.Result := HT_IN;
    Exit;
  end;
end;

Метод обработки команды VOC_HITTEST выглядит громоздким, однако и в нем все достаточно тривиально. Его можно было бы переписать более компактно, но в таком виде он понятнее. Сначала все базовые точки переводятся в экранные координаты, а потом последовательно проверяем, лежит ли точка с координатами (Command.Params.XPos; Command.Params.YPos) на одной из вершин/сторон объекта (с учетом допускаемой погрешности Command.Params.Tolerance) или внутри его. Например, если мы при реализации контейнера зададим Tolerance равным 2, то пользователь сможет "промахнуться" мимо вершины или стороны объекта на 2 пикселя, и при этом будет считаться, что мышь над соответствующей частью объекта.

Метод обработки команды VOC_GETCURSOR принимает в качестве параметра область объекта и возвращает рекомендуемый вид курсора. Например, для левой и правой стороны он вернет код курсора, который можно интерпретировать как "горизонтальная двунаправленная стрелка".

Теперь разберемся с конструированием таких объектов. Оно будет сводиться к двум последовательным щелчкам левой кнопкой мыши, между которым, в процессе движения мыши, будет отображаться предварительный вид объекта. Если после первого щелчка левой кнопкой мыши, пользователь нажмет правую - конструирование объекта будет отменено. После второго щелчка левой кнопкой - конструирование объекта будет закончено. Реализуем все вышесказанное с помощью команд, введенных нами ранее.

type
  // Базовый класс для "прямоугольных" объектов
  TRectVisualObject = class(TBaseVisualObject)
  private
    ...
    FConstructing: Boolean;
    FCurrentPoint: Integer;
    procedure VOCConstructPoint(var Command: TVOCConstructPoint);
      message VOC_CONSTRUCTPOINT;
    procedure VOCProcessConstruct(var Command: TVOCProcessConstruct);
      message VOC_PROCESSCONSTRUCT;
    procedure VOCStopConstruct(var Command: TVOCStopConstruct);
      message VOC_STOPCONSTRUCT;
  end;
...
implementation
...
{ TRectVisualObject }

procedure TRectVisualObject.VOCConstructPoint(
  var Command: TVOCConstructPoint);
begin
  // Если объект не находится в режиме конструирования - переводим его в этот
  // режим и устанавливаем начальный номер текущей редактируемой точки
  if not FConstructing then begin
    FConstructing := True;
    FCurrentPoint := 0;
  end;
  // В зависимости от номера редактируемой точки, выполняем нужные действия
  // позиционирования
  case FCurrentPoint of
    0:
      begin
        // Перемещаем все точки объекта в стартовую
        BasePoints[0] := Command.Pos^;
        BasePoints[1] := Command.Pos^;
        // Конструирование не окончено
        Command.Result := 1;
      end;
    1:
      begin
        // Перемещаем точку с индексом 1
        BasePoints[1] := Command.Pos^;
        // Конструирование окончено
        FConstructing := False;
        Command.Result := 0;
      end;
  else
    TList.Error(@SListIndexError, FCurrentPoint);
  end;
  // Инкремент индекса текущей точки
  Inc(FCurrentPoint);
end;

procedure TRectVisualObject.VOCProcessConstruct(
  var Command: TVOCProcessConstruct);
begin
  // Перемещаем вершину, соответствующую текущей точке.
  if FConstructing then
    case FCurrentPoint of
      0: Vertex[0] := Command.Pos^;
      1: Vertex[2] := Command.Pos^;
    end;
end;

procedure TRectVisualObject.VOCStopConstruct(
  var Command: TVOCStopConstruct);
begin
  Command.Result := 1;
  if FConstructing then begin
    // Выходим из режима конструирования сигнализируем вызывающий код о том,
    // что объект не достроен до конца
    FConstructing := False;
    Command.Result := 0;
  end;
end;

При получении команды VOC_CONSTRUCTPOINT первый раз - будем переводить объект в режим конструирования, и перемещать все его точки в стартовую. При получении второй раз - устанавливаем позицию второй базовой точки и выходим из режима конструирования. В параметре Result возвращаем 0, сигнализирующий о том, что конструирование закончено. В обработчике команды VOC_PROCESSCONSTRUCT просто обновляем позицию вершины, соответствующей текущей редактируемой точки. Именно вершину изменяем, а не базовую точку, так как при изменении вершины контролируется, чтобы мы вторую точку не задвинули левее или выше первой. В обработчике VOC_STOPCONSTRUCT - выходим из режима конструирования и сигнализируем о том, что конструирование отменено, и объект следует уничтожить. Отправляющий команду код уведомляется об этом через параметр Result, в котором записываем 0.

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

type
  // Базовый класс для "прямоугольных" объектов
  TRectVisualObject = class(TBaseVisualObject)
  private
    ...
    FText: String;
    procedure SetText(const Value: String);
    ...
  public
    // Текст элемента
    property Text: String read FText write SetText;
  end;
...
implementation
...
{ TRectVisualObject }

procedure TRectVisualObject.SetText(const Value: String);
begin
  if FText <> Value then begin
    FText := Value;
    Change;
  end;
end;
С прямоугольными объектами закончили, можно смело переходить к объектам-линиям.

Объекты, состоящие из линий

Также постараемся включить общее для объектов поведение в базовый класс, а именно: Команда VOC_SIDEMOVE такими объектами будет игнорироваться.
Зададим соответствие между вершинами и базовыми точками. 
type
...
  // Базовый класс для объектов-линий
  TLineVisualObject = class(TBaseVisualObject)
  protected
    function GetVertexesCount: Integer; override;
    function GetVertex(Index: Integer): TFloatPoint; override;
    procedure SetVertex(Index: Integer; const Value: TFloatPoint); override;
  end;
...
implementation
...
{ TLineVisualObject }

function TLineVisualObject.GetVertex(Index: Integer): TFloatPoint;
begin
  Result := BasePoints[Index];
end;

function TLineVisualObject.GetVertexesCount: Integer;
begin
  Result := BasePointsCount;
end;

procedure TLineVisualObject.SetVertex(Index: Integer;
  const Value: TFloatPoint);
begin
  BasePoints[Index] := Value;
end;

Тут все очевидно. Можно сразу переходить к обработке команд VOC_HITTEST и VOC_GETCURSOR.

type
...
  // Базовый класс для объектов-линий
  TLineVisualObject = class(TBaseVisualObject)
  private
    procedure VOCHitTest(var Command: TVOCHitTest); message VOC_HITTEST;
    procedure VOCGetCursor(var Command: TVOCGetCursor); message VOC_GETCURSOR;
  end;
...
implementation
...
{ TLineVisualObject }

procedure TLineVisualObject.VOCGetCursor(var Command: TVOCGetCursor);
begin
  if Command.HitTest <> HT_OUT then
    Command.Result := CR_SIZEALL
  else
    Command.Result := CR_DEFAULT;
end;

procedure TLineVisualObject.VOCHitTest(var Command: TVOCHitTest);
var
  i, sX1, sY1, sX2, sY2: Integer;
  D: Extended;
begin
  Command.Result := HT_OUT;
  for i := VertexesCount - 1 downto 0 do begin
    // Переводим в экранные координаты
    Command.ConvertIntf.LogToScreen(Vertex[i].X, Vertex[i].Y, sX1, sY1);
    if (Abs(Command.Params.XPos - sX1) <= Command.Params.Tolerance) and
       (Abs(Command.Params.YPos - sY1) <= Command.Params.Tolerance)
    then begin
      // Вершина i
      Command.Result := HT_VERTEX + i;
      Exit;
    end;
  end;
  // Не на линии ли?
  for i := VertexesCount - 1 downto 1 do begin
    Command.ConvertIntf.LogToScreen(Vertex[i].X, Vertex[i].Y, sX1, sY1);
    Command.ConvertIntf.LogToScreen(Vertex[i - 1].X, Vertex[i - 1].Y, sX2, sY2);
    D := LineDistance(Command.Params.XPos, Command.Params.YPos,
      sX1, sY1, sX2, sY2);
    if D <= Command.Params.Tolerance then begin
      // На линии
      Command.Result := HT_IN + i - 1;
      Exit;
    end;
  end;
end;

В обработчике VOC_HITTEST мы в цикле проходим по всем вершинам и определяем таким же образом, как в прямоугольных объектах, принадлежность точки вершине. Если вершина найдена - выходим из метода, иначе в следующем цикле проверяем расстояние от точки до отрезка, соединяющего (i - 1)-ю и i-ю вершину. Если оно не превышает допустимую погрешность, то считаем, что точка лежит на линии. Реализацию функции LineDistance, которая рассчитывает расстояние от точки до отрезка, вы найдете в прилагаемых к статье файлах, приводить ее здесь смысла нет. Кстати, используя подобный цикл по вершинам и функцию LineDistance, мы могли бы сократить код обработки команды VOC_HITTEST у прямоугольных объектов.

Теперь реализуем конструирование объектов. Конструирование будет также сводиться к последовательным щелчкам левой кнопкой для фиксации положения вершин, а правая кнопка - завершит конструирование. При этом у объекта останутся только те вершины, что мы успели зафиксировать. Редактируемая вершина будет удаляться.

При получении команды VOC_CONSTRUCTPOINT - будем фиксировать положение текущей редактируемой вершины и добавлять следующую. В этом же методе будем определять, завершено ли конструирование или нет. Для соединительной и ломаной линии здесь поведение будет отличным. При получении команды VOC_PROCESSCONSTRUCT - будем перемещать текущую точку в новую позицию. При получении команды VOC_STOPCONSTRUCT - будем завершать конструирование, удалять текущую редактируемую точку и при необходимости - сигнализировать о том, что объект недостроен.

type
...
  // Базовый класс для объектов-линий
  TLineVisualObject = class(TBaseVisualObject)
    ...
    FConstructing: Boolean;
    FCurrentPoint: Integer;
    procedure VOCConstructPoint(var Command: TVOCConstructPoint);
      message VOC_CONSTRUCTPOINT;
    procedure VOCProcessConstruct(var Command: TVOCProcessConstruct);
      message VOC_PROCESSCONSTRUCT;
    procedure VOCStopConstruct(var Command: TVOCStopConstruct);
      message VOC_STOPCONSTRUCT;
  protected
    ...
    // Определения момента завершения конструирования
    function NeedToStopConstruct(Count: Integer): Longint; virtual; abstract;
  end;
...
implementation
...
{ TLineVisualObject }

procedure TLineVisualObject.VOCConstructPoint(
  var Command: TVOCConstructPoint);
begin
  // Если конструирование только начато - переводим объект в режим
  // конструирования, устанавливаем начальные параметры и фиксируем первую точку
  if not FConstructing then begin
    FConstructing := True;
    BeginUpdate;
    try
      ClearBasePoints;
      FCurrentPoint := 0;
      AddBasePoint(Command.Pos^.X, Command.Pos^.Y);
    finally
      EndUpdate;
    end;
  end;
  // Ответ на вопрос, необходимо ли завершить конструирование, перекладываем
  // на виртуальный метод NeedToStopConstruct
  Command.Result := NeedToStopConstruct(FCurrentPoint + 1);
  if Command.Result = 0 then begin;
    FConstructing := False;
    Exit;
  end;
  // Добавляем новую точку и изменяем индекс редактируемой
  AddBasePoint(Command.Pos^.X, Command.Pos^.Y);
  Inc(FCurrentPoint);
end;

procedure TLineVisualObject.VOCProcessConstruct(
  var Command: TVOCProcessConstruct);
begin
  // Перемещаем текущую точку
  if FConstructing then
    BasePoints[FCurrentPoint] := Command.Pos^;
end;

procedure TLineVisualObject.VOCStopConstruct(
  var Command: TVOCStopConstruct);
begin
  Command.Result := 1;
  if FConstructing then begin
    // Выходим из режима конструирования, удаляем текущую точку и если
    // установлено меньше двух точек - уничтожаем объект
    FConstructing := False;
    DeleteBasePoint(FCurrentPoint);
    if VertexesCount < 2 then begin
      Free;
      Command.Result := 0;
    end;
  end;
end;

Следует пояснить назначение метода NeedToStopConstruct. Этот метод мы перекроем в потомках, чтобы задать соединительной и ломаной линии возможность самостоятельно определить, закончено ли конструирование. При этом если для ломаной линии этот метод будет всегда возвращать код "не закончено" (единственный способ завершить конструирование ломаной - отправить команду VOC_STOPCONSTRUCT), то соединительная линия вернет код "закончено" при установке второй вершины. В этом случае, третья вершина к объекту добавлена не будет, объект просто выйдет из режима конструирования.

Ну и рисование объекта - просто последовательно рисуем все вершины и соединяем их линиями:

type
...
  // Базовый класс для объектов-линий
  TLineVisualObject = class(TBaseVisualObject)
  public
    procedure Draw(Canvas: TLogicalCanvas); override;
  end;
...
implementation
...
{ TLineVisualObject }

procedure TLineVisualObject.Draw(Canvas: TLogicalCanvas);
var
  i: Integer;
begin
  inherited;
  // Соединяем вершины линиями
  for i := 1 to VertexesCount - 1 do
    Canvas.DrawLine(Vertex[i - 1].X, Vertex[i - 1].Y, Vertex[i].X, Vertex[i].Y, 0.5);
end;

Реализация конкретных классов визуальных объектов.

Теперь, когда у нас есть все базовые классы, можно приступить к реализации конкретных объектов. Для примера покажем реализацию объекта "Блок начало/конец" и "ломаной линии". Код остальных объектов принципиально ничем не будет отличаться, приводить в статье его не будем, однако в прилагаемых к статье исходниках он присутствует.

"Блок начало/конец" реализовать достаточно просто. Достаточно просто перекрыть метод Draw, все остальное реализовано в классах-предках.

type
  ...
  TBeginEndBlock = class(TRectVisualObject)
  public
    procedure Draw(Canvas: TLogicalCanvas); override;
  end;
...
implementation
...
{ TBeginEndBlock }

procedure TBeginEndBlock.Draw(Canvas: TLogicalCanvas);
begin
  Canvas.DrawRoundRect(BasePoints[0].X, BasePoints[0].Y, BasePoints[1].X,
    BasePoints[1].Y, 0.5);
  Canvas.DrawText(BasePoints[0].X, BasePoints[0].Y, BasePoints[1].X,
    BasePoints[1].Y, 3, Text);
  inherited Draw(Canvas);
end;

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

const
  ...
  VOC_VCONTROL		= 12;

type
  ...
  // Управление вершинами
  TVOCVControl = packed record
    CmdID: Cardinal;
    HitTest: Cardinal;      // Область щелчка
    Pos: PFloatPoint;       // Позиция, в которую будет добавлена новая вершина
    Result: Longint;
  end;
  ...
  TPolyLineBlock = class(TLineVisualObject)
  private
    procedure VOCVControl(var Command: TVOCVControl); message VOC_VCONTROL;
  protected
    function NeedToStopConstruct(Count: Integer): Longint; override;
  end;
...
implementation
...
{ TPolyLineBlock }

function TPolyLineBlock.NeedToStopConstruct(Count: Integer): Longint;
begin
  // Завершить конструирование можно только с помощью команды VOC_STOPCONSTRUCT
  Result := 1;
end;

procedure TPolyLineBlock.VOCVControl(var Command: TVOCVControl);
var
  HitTest: Cardinal;
  Index: Integer;
begin
  // Раскладываем Command.HitTest на общий код области и индекс
  HitTest := Command.HitTest and $FFFF0000;
  Index := Command.HitTest and $0000FFFF;
  // В зависимости от HitTest добавляем или удаляем вершину. Вершина не удаляется
  // если их количество станет меньше двух.
  case HitTest of
    HT_IN: InsertBasePoint(Index + 1, Command.Pos^.X, Command.Pos^.Y);
    HT_VERTEX: if VertexesCount > 2 then
      DeleteBasePoint(Index);
  end;
end;

Последние штрихи.

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

А кто будет инстанцировать объекты - создавать экземпляры конкретных классов и заносить их в список контейнера? Очевидно, сам контейнер при конструировании объектов пользователем. Но как контейнер будет знать, объект какого именно типа мы хотим создать, и как написать универсальный код инстанцирования? Ответом на первый вопрос напрашивается передавать тип конструируемого объекта извне. Для решения этой задачи в Delphi есть специальный тип - метакласс. Объявляется он с помощью зарезервированных слов "class of":

type
  ...
  // Метакласс визуальных объектов
  TVisualObjectClass = class of TBaseVisualObject;

Значением переменных этого типа будут не экземпляры класса, а сами классы, потомки TBaseVisualObject. Используя метакласс, мы можем написать универсальный код инстанцирования объектов. Другими словами, если нам передана переменная типа метакласс (или как еще говорят - классовая ссылка), мы можем создать экземпляр неизвестного на этапе компиляции класса таким образом:

var
  ClassRef: TVisualObjectClass;
  Obj: TBaseVisualObject;
...
begin
...
  Obj := ClassRef.Create;

Единственное требование, которое нужно соблюсти - конструктор базового класса TBaseVisualObject должен быть виртуальным. Вернемся чуть назад и объявим его таковым (а в потомках - напишем override):

type
  TBaseVisualObject = class(TObject)
  ...
  public
    constructor Create; virtual;
...
  TRectVisualObject = class(TBaseVisualObject)
  ...
  public
    constructor Create; override;

Теперь контейнер может даже создавать объекты, не задумываясь об их типе. А этот тип мы будем контейнеру передавать извне.

Реализация контейнера.

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

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

На что следует обратить внимание в коде этого компонента - это на методы обработки сообщений от мыши (в них мышиные сообщения транслируются в команды объектов и передаются последним), на метод Paint, рисующий все объекты на поверхности компонента, на методы перевода из одной системы координат в другие. Также обратите внимание на свойство ObjectType, которое задает тип конструируемого объекта, а когда оно равно nil - контейнер находится в режиме управления объектами (перемещение, выделение), а не конструирования.

Выводы.

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



Литература:
Э. Гамма, Р. Хелм, Р. Джонсон, Дж. Влиссидес - "Приемы объектно-ориентированного проектирования. Паттерны проектирования".

К материалу прилагаются файлы: