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
и код его методов, относящихся к перехвату сообщений.
Листинг 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;
Читать дальше
Конец ознакомительного отрывка
Купить книгу