О чём не пишут в книгах по Delphi

Григорьев Антон Борисович

Листинг 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, поэтому, используя хакерские