"О чём не пишут в книгах по Delphi" - читать интересную книгу автора (Григорьев А. Б.)

1.2.2. Пример Line

Пример Line представляет собой невизуальный компонент TLine, который перехватывает оконные сообщения своего владельца (владельца в терминах VCL, разумеется, раз речь идет о неоконном компоненте). Компонент TLine рисует на своем владельце линию из точки (StartX, StartY) в точку (EndX, EndY) цветом Color. Пользователь может перемещать концы линии мышью. Достаточно разместить компонент TLine на форме, и на ней появится линия, которую пользователь может перемещать как во время проектирования формы, так и во время выполнения программы. Можно также разместить на форме, например, панель, и сделать ее владельцем компонента TLine — тогда линия будет рисоваться на панели. Но это можно сделать только во время исполнения программы, потому что владельцем всех компонентов, созданных во время проектирования формы, становится сама форма. Чтобы установить компонент, нужно выполнить следующие действия:

1. Переписать с компакт-диска файлы Line.pas и Line.dcr в папку, где вы храните компоненты. Если такой папки еще нет, самое время создать ее. Где именно она будет расположена, значения не имеет, выбирайте любое удобное для вас место. Главное — это прописать эту папку в путях, где Delphi ищет компоненты. Чтобы сделать это в Delphi 7 и более ранних версиях, откройте меню Tools\Environment Options, в появившемся диалоговом окне выберите закладку Library и добавьте свою папку в поле Library path. В BDS 2006 и выше откройте меню Tools\Options, в появившемся диалоговом окне в дереве в левой части выберите пункт Environment Options\Delphi Options\Library — Win32 и добавьте папку в поле Library path.

2. Создайте новый пакет (меню File\New\Other, в открывшемся окне выбрать Package). После этого в Delphi 7 и более ранних версиях откроется небольшое окно пакета. В BDS 2006 и более поздних версиях окно не откроется, но пакет появится в группе проектов (по умолчанию это окно Project Manager в правом верхнем углу главного окна). Сохраните пакет в ту же папку, где находится Line.pas, под любым именем, кроме Line (иначе будет конфликт имен).

3. Добавьте в пакет файл Line.pas. В BDS 2006 для этого необходимо с помощью правой кнопки мыши вызвать контекстное меню пакета в окне Project Manager и выбрать там пункт Add. В Delphi 7 и более ранних версиях в окне пакета нужно нажать кнопку Add.

4. Установите компонент. В BDS 2006 и выше для этого следует выбрать пункт Install в контекстном меню проекта, а в Delphi 7 и более ранних версиях — нажать кнопку Install в окне пакета. После этого в палитре компонентов у вас появится вкладка Delphi Kingdom Samples, a в ней — компонент TLine.

Если вы не хотите помещать компонент TLine в палитру компонентов (или у вас Turbo Delphi Explorer, и вы просто не имеете такой возможности), можно воспользоваться проектом LineSample, который во время выполнения создаёт два экземпляра TLine, владельцем одного из которых является форма, другого — панель.

Перехват сообщения владельца осуществляется путем изменения его свойства WindowProc — записи в него указателя на свой обработчик сообщений. Здесь можно применить один хитрый прием. Компонент TLine не имеет своей оконной процедуры, т.к., будучи прямым наследником класса TComponent, окном не является. Но метод Dispatch у него есть, поскольку он объявлен в классе TObject. В классе TComponent и в его предках метод Dispatch никогда не вызывается. Если мы напишем обработчик сообщений таким образом, что он будет передавать сообщения методу Dispatch, то сможем в нашем компоненте создавать свои методы для обработки сообщений, в которые метод Dispatch при необходимости будет передавать сообщения для обработки. Необработанные сообщения при этом будут передаваться в метод DefaultHandler, который у класса TComponent ничего не делает. Если мы перекроем DefaultHandler так, чтобы он вызывал оригинальный обработчик сообщений родителя, то все необработанные сообщения пойдут туда. Более того, вызов inherited из методов-обработчиков сообщений тоже будет приводить к вызову оригинального обработчика родителя, т.к. в данном случае inherited при отсутствии унаследованного обработчика приводит к вызову DefaultHandler. В листинге 1.24 показано объявление класса TLine и код его методов, относящихся к перехвату сообщений.

type

 TLine = class(TComponent)

 private

  // FCoords хранит координаты линии. Начало линии

  // находится в точке (FCoords[0], FCoords[1]),

  // конец - в (FCoords[2], FCoords[3]).

  FCoords:array[0..3] of Integer;

  // Конструктор класса написан так, что владельцем TLine

  // может стать только TWinControl или его наследник.

  // Но свойство Owner имеет тип TComponent, поэтому при

  // использовании свойств и методов класса TWinControl

  // Owner придется каждый раз приводить к типу

  // TWinControl. Чтобы избежать приведений типа,

  // используется поле FWinOwner. Оно указывает на тот же

  // объект, что и Owner, но имеет тип TWinControl.

  FWinOwner: TWinControl;

  // Здесь хранится адрес обработчика сообщений, бывший до

  // перехвата.

  FOldProc: TWndMethod;

  // Цвет линии

  FColor: TColor;

  // Состояние линии. Если FStartMoving = True, в данный

  // момент пользователь перемещает начало линии, если

  // FEndMoving = True - ее конец.

  FStartMoving, FEndMoving: Boolean;

  // Если FDrawLine = False, линия не рисуется. Это

  // используется, когда нужно стереть линию.

  FDrawLine: Boolean;

  procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;

  procedure WMLButtonDown(var Msg: TWMLButtonDown); message WM_LBUTTONDOWN;

  procedure WMLButtonUp(var Msg: TWMButtonUp); message WM_LBUTTONUP;

  procedure WMMouseMove(var Msg: TWMMouseMove); message WM_MOUSEMOVE;

  procedure SetColor(Value: TColor);

  procedure SetCoord(Index, Value: Integer);

 protected

  // Этот метод будет новым обработчиком сообщений

  // владельца

  procedure HookOwnerMessage(var Msg: Message);

 public

  constructor Create(AOwner: TComponent); override;

  destructor Destroy; override;

  procedure DefaultHandler(var Msg); override;

 published

  property Color: TColor read FColor write SetColor default clWindowText;

  property StartX: Integer index 0 read FCoords[0] write SetCoord default 10;

  property StartY: Integer index 1 read FCoords[1] write SetCoord default 10;

  property EndX: Integer index 2 reed FCoords[2] write SetCoord default 50;

  property EndY: Integer index 3 read FCoords[3] write SetCoord default 50;

 end;

...

constructor TLine.Create(AOwner: TComponent);

begin

 if not Assigned(AOwner) then raise EWrongOwner.Create(

  'Должен быть назначен владелец компонента TLine');

 if not (AOwner is TWinControl) then raise EWrongOwner.Create(

  'Владелец компонента TLine должен быть наследником TWinControl');

 FWinOwner := AOwner as TWinControl;

 inherited;

 FCoords[0] := 10;

 FCoords[1] := 10;

 FCoords[2] := 50;

 FCoords[3] := 50;

 FColor := clWindowText;

 FStartMoving := False;

 FEndMoving := False;

 FDrawLine := True;

 // Запоминаем старый обработчик сообщений владельца и

 // назначаем новый.

 FOldProc := FWinOwner.WindowProc;

 FWinOwner.WindowProc := HookOwnerMessage;

 FWinOwner.Refresh;

end;

destructor TLine.Destroy;

begin

 // Восстанавливаем старый обработчик сообщений владельца.

 FWinOwner.WindowProc := FOldProc;

 FWinOwner.Refresh;

 inherited;

end;

procedure TLine.HookOwnerMessage(var Msg: TMessage);

begin

 // Единственное, что делает перехватчик сообщений -

 // передает их методу Dispatch. Было бы оптимальнее

 // назначить обработчиком сообщений сам метод Dispatch,

 // но формально он имеет прототип, несовместимый с

 // типом TWndMethod, поэтому компилятор не разрешает

 // подобное присваивание. Фактически же Dispatch

 // совместим с TWndMethod, поэтому, используя хакерские

 // методы, можно было бы назначить обработчиком его и

 // обойтись без метода HookOwnerMessage. Но хакерские

 // методы - вещь небезопасная, они допустимы только

 // тогда, когда других средств решения задачи нет.

 Dispatch(Msg);

end;

procedure TLine.DefaultHandler(var Msg);

begin

 FOldProc(TMessage(Msg));

end;

Собственно рисование линии на поверхности владельца обеспечивает метод WMPaint (листинг 1.25).

procedure TLine.WMPaint(var Msg: TWMPaint);

var

 NeedDC: Boolean;

 PS: TPaintStruct;

 Pen: HPEN;

begin

 if FDrawLine then

 begin

  // Проверка, был ли DC получен предыдущим обработчиком

  NeedDC := Msg.DC = 0;

  if NeedDC then Msg.DC := BeginPaint(FWinOwner.Handle, PS);

  inherited;

  Pen := CreatePen(PS_SOLID, 1, ColorToRGB(FColor));

  SelectObject(Msg.DC, Pen);

  MoveToEx(Msg.DC, FCoords[0], FCoords[1], nil);

  LineTo(Msg.DC, FCoords[2], FCoords[3]);

  SelectObject(Msg.DC, GetStockObject(BLACK_PEN));

  DeleteObject(Pen);

  if NeedDC then EndPaint(FWinOwner.Handle, PS);

 end

 else inherited;

end;

Поскольку рисуется простая линия, мы не будем здесь создавать экземпляр TCanvas и привязывать его к контексту устройства, обойдемся вызовом функций GDI. Особенности работы с контекстом устройства при перехвате сообщения WM_PAINT описаны в разд. 1.2.4.

Чтобы пользователь мог перемещать концы линии, нужно перехватывать и обрабатывать сообщения, связанные с перемещением мыши и нажатием и отпусканием ее левой кнопки (листинг 1.26).

procedure TLine.WMLButtonDown(var Msg: TWMLButtonDown);

var

 DC: HDC;

 OldMode: Integer;

begin

 if PTInRect(Rect(FCoords[0] - 3, FCoords[1] - 3, FCoords[0] + 4, FCoords[1] + 4), Point(Msg.XPos, Msg.YPos)) then

 begin

  FStartMoving := True;

  FDrawLine := False;

  FWinOwner.Refresh;

  FDrawLine := True;

  DC := GetDC(FWinOwner.Handle);

  OldMode := SetROP2(DC, R2_NOT);

  SelectObject(DC, GetStockObject(BLACK_PEN));

  MoveToEx(DC, FCoords[0], FCoords[1], nil);

  LineTo(DC, FCoords[2], FCoords[3]);

  SetROP2(DC, OldMode);

  ReleaseDC(FWinOwner.Handle, DC);

  SetCapture(FWinOwner.Handle);

  Msg.Result := 0;

 end

 else

  if PTInRect(Rect(FCoords[2] - 3, FCoords[3] - 3, FCoords[2] + 4, FCoords[3] + 4), Point(Msg.XPos, Msg.YPos)) then

  begin

   FEndMoving := True;

   FDrawLine := False;

   FWinOwner.Refresh;

   FDrawLine := True;

   DC := GetDC(FWinOwner.Handle);

   OldMode := SetROP2(DC, R2_NOT);

   SelectObject(DC, GetStockObject(BLACK_PEN));

   MoveToEx(DC, FCoords[0], FCoords[1], nil);

   LineTo(DC, FCoords[2], FCoords[3]);

   SetROP2(DC, OldMode);

   ReleaseDC(FWinOwner.Handle, DC);

   SetCapture(FWinOwner.Handle);

   Msg.Result := 0;

  end

else inherited;

end;

procedure TLine.WMLButtonUp(var Msg: TWMLButtonUp);

begin

 if FStartMoving then

 begin

  FStartMoving := False;

  ReleaseCapture;

  FWinOwner.Refresh;

  Msg.Result := 0;

 end

 else if FEndMoving then

 begin

  FEndMoving := False;

  ReleaseCapture;

  FWinOwner.Refresh;

  Msg.Result := 0;

 end

 else inherited;

end;

procedure TLine.WMMouseMove(var Мsg: TWMMouseMove);

var

 DC: HDC;

 OldMode: Integer;

begin

 if FStartMoving then

 begin

  DC := GetDC(FWinOwner.Handle);

  OldMode := SetROP2(DC, R2_NOT);

  SelectObject(DC, GetStockObject(BLACK_PEN));

  MoveToEx(DC, FCoords[0], FCoords[1], nil);

  LineTo(DC, FCoords[2], FCoords[3]);

  FCoords[0] := Msg.XPos;

  FCoords[1] := Msg.YPos;

  MoveToEx(DC, FCoords[0], FCoords[1], nil);

  LineTo(DC, FCoords[2], FCoords[3]));

  SetROP2(DC, OldMode);

  ReleaseDC(FWinOwner.Handle, DC);

  Msg.Result := 0;

 end

 else if FEndMoving then

 begin

  DC := GetDC(FWinOwner.Handle);

  OldMode := SetROP2(DC, R2_NOT);

  SelectObject(DC, GetStockObject(BLACK_PEN));

  MoveToEx(DC, FCoords[0], FCoords[1], nil);

  LineTo(DC, FCoords[2], FCoords[3]);

  FCoords[2] := Msg.XPos;

  FCoords[3] := Msg.YPos;

  MoveToEx(DC, FCoords[0], FCoords[1], nil);

  LineTo(DC, FCoords[2], FCoords[3]);

  SetROP2(DC, OldMode);

  ReleaseDC(FWinOwner.Handle, DC);

  Msg.Result := 0;

 end

 else inherited;

end;

Здесь реализован инверсный способ создания "резиновой" линии, когда при рисовании линии все составляющие ее пикселы инвертируются, а при стирании инвертируются еще раз. Этот способ подробно описан в разд. 1.3.4.2. Перехват сообщений родителя — дело относительно простое, гораздо хуже обстоят дела с удалением компонента, перехватившего сообщения родителя. Пока такой компонент один, проблем не возникает, но когда их несколько приходится обращаться с ними очень аккуратно. Рассмотрим, например, такой код (листинг 1.27).

Line1 := TLine.Create(Form1);

Line2 := TLine.Create(Form2);

...

Line1.Free;

...

Line2.Free;

Проанализируем, что происходит при выполнении этого кода. Для простоты предположим, что других компонентов, перехватывающих сообщения, здесь нет, и перед выполнением этого кода Form1.WindowProc ссылается на Form1.WndProc, т.е. на собственный обработчик сообщений формы. При создании объекта Line1 он перехватывает обработчик, и Form1.WindowProc начинает ссылаться на Line1.HookOwnerMessage, а ссылка на Form1.WndProc сохраняется в Line1.FOldProc. Объект Line2 также перехватывает обработчик сообщений, и после его создания Form1.WindowProc будет ссылаться на Line2.HookOwnerMessage, a Line2.FOldProc — на Line1.HookOwnerMessage.

Теперь удалим Line1. При удалении объект восстановит ссылку на тот обработчик сообщений, который был установлен на момент его создания, т.е. Form1.WindowProc вновь станет указывать на Form1.WndProc. Соответственно, компонент Line2 потеряет способность реагировать на сообщения владельца. Поле Line2.FOldProc при этом останется без изменений. Но самое неприятное начнется при удалении объекта Line2. Он тоже восстановит ссылку на обработчик, который был назначен на момент его создания, т.е. запишет в свойство Form1.WindowProc ссылку на Line1.HookOwnerMessage. Но поскольку объекта Line1 уже не существует, это будет ссылка в никуда, и обработка первого же сообщения, пришедшего форме, даст ошибку Access violation.

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