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

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;

...